diff --git a/basis/cairo/gadgets/gadgets.factor b/basis/cairo/gadgets/gadgets.factor index 131f7425c9..87942b4c91 100644 --- a/basis/cairo/gadgets/gadgets.factor +++ b/basis/cairo/gadgets/gadgets.factor @@ -2,19 +2,26 @@ ! See http://factorcode.org/license.txt for BSD license. USING: sequences math kernel byte-arrays cairo.ffi cairo io.backend ui.gadgets accessors opengl.gl arrays fry -classes ui.render namespaces ; - +classes ui.render namespaces destructors libc ; IN: cairo.gadgets +stride ( width -- stride ) 4 * ; + +: image-dims ( gadget -- width height stride ) + dim>> first2 over width>stride ; inline +: image-buffer ( width height stride -- alien ) + * nip malloc ; inline +PRIVATE> GENERIC: render-cairo* ( gadget -- ) -: render-cairo ( gadget -- byte-array ) - dup dim>> first2 over width>stride - [ * nip dup CAIRO_FORMAT_ARGB32 ] - [ cairo_image_surface_create_for_data ] 3bi - rot '[ _ render-cairo* ] with-cairo-from-surface ; inline +: render-cairo ( gadget -- alien ) + [ + image-dims + [ image-buffer dup CAIRO_FORMAT_ARGB32 ] + [ cairo_image_surface_create_for_data ] 3bi + ] [ '[ _ render-cairo* ] with-cairo-from-surface ] bi ; TUPLE: cairo-gadget < gadget ; @@ -23,11 +30,13 @@ TUPLE: cairo-gadget < gadget ; swap >>dim ; M: cairo-gadget draw-gadget* - [ dim>> ] [ render-cairo ] bi - origin get first2 glRasterPos2i - 1.0 -1.0 glPixelZoom - [ first2 GL_BGRA GL_UNSIGNED_BYTE ] dip - glDrawPixels ; + [ + [ dim>> ] [ render-cairo &free ] bi + origin get first2 glRasterPos2i + 1.0 -1.0 glPixelZoom + [ first2 GL_BGRA GL_UNSIGNED_BYTE ] dip + glDrawPixels + ] with-destructors ; : copy-surface ( surface -- ) cr swap 0 0 cairo_set_source_surface diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index 36f427d5ad..1b912299e8 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -604,7 +604,7 @@ HELP: MIXIN: HELP: INSTANCE: { $syntax "INSTANCE: instance mixin" } -{ $values { "instance" "a class word" } { "instance" "a class word" } } +{ $values { "instance" "a class word" } { "mixin" "a mixin class word" } } { $description "Makes " { $snippet "instance" } " an instance of " { $snippet "mixin" } "." } ; HELP: PREDICATE: diff --git a/extra/literals/authors.txt b/extra/literals/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/literals/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/literals/literals-docs.factor b/extra/literals/literals-docs.factor new file mode 100644 index 0000000000..ae25c75495 --- /dev/null +++ b/extra/literals/literals-docs.factor @@ -0,0 +1,61 @@ +! Copyright (C) 2008 Joe Groff. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax multiline ; +IN: literals + +HELP: $ +{ $syntax "$ word" } +{ $description "Executes " { $snippet "word" } " at parse time and adds the result(s) to the parser accumulator." } +{ $notes "Since " { $snippet "word" } " is executed at parse time, " { $snippet "$" } " cannot be used with words defined in the same compilation unit." } +{ $examples + + { $example <" +USING: kernel literals prettyprint ; +IN: scratchpad + +<< : five 5 ; >> +{ $ five } . + "> "{ 5 }" } + + { $example <" +USING: kernel literals prettyprint ; +IN: scratchpad + +<< : seven-eleven 7 11 ; >> +{ $ seven-eleven } . + "> "{ 7 11 }" } + +} ; + +HELP: $[ +{ $syntax "$[ code ]" } +{ $description "Calls " { $snippet "code" } " at parse time and adds the result(s) to the parser accumulator." } +{ $notes "Since " { $snippet "code" } " is executed at parse time, it cannot reference any words defined in the same compilation unit." } +{ $examples + + { $example <" +USING: kernel literals math prettyprint ; +IN: scratchpad + +<< : five 5 ; >> +{ $[ five dup 1+ dup 2 + ] } . + "> "{ 5 6 8 }" } + +} ; + +{ POSTPONE: $ POSTPONE: $[ } related-words + +ARTICLE: "literals" "Interpolating code results into literal values" +"The " { $vocab-link "literals" } " vocabulary contains words to run code at parse time and insert the results into more complex literal values." +{ $example <" +USING: kernel literals math prettyprint ; +IN: scratchpad + +<< : five 5 ; >> +{ $ five $[ five dup 1+ dup 2 + ] } . + "> "{ 5 5 6 8 }" } +{ $subsection POSTPONE: $ } +{ $subsection POSTPONE: $[ } +; + +ABOUT: "literals" diff --git a/extra/literals/literals-tests.factor b/extra/literals/literals-tests.factor index b88a286a59..185d672dd3 100644 --- a/extra/literals/literals-tests.factor +++ b/extra/literals/literals-tests.factor @@ -1,4 +1,4 @@ -USING: kernel literals tools.test ; +USING: kernel literals math tools.test ; IN: literals.tests << @@ -10,3 +10,5 @@ IN: literals.tests [ { 5 } ] [ { $ five } ] unit-test [ { 7 11 } ] [ { $ seven-eleven } ] unit-test [ { 6 6 6 } ] [ { $ six-six-six } ] unit-test + +[ { 8 8 8 } ] [ { $[ six-six-six [ 2 + ] tri@ ] } ] unit-test diff --git a/extra/literals/literals.factor b/extra/literals/literals.factor index d46f492cd4..a450c2118e 100644 --- a/extra/literals/literals.factor +++ b/extra/literals/literals.factor @@ -1,4 +1,6 @@ -USING: continuations kernel parser words ; +! (c) Joe Groff, see license for details +USING: continuations kernel parser words quotations ; IN: literals : $ scan-word [ execute ] curry with-datastack ; parsing +: $[ \ ] parse-until >quotation with-datastack ; parsing diff --git a/extra/literals/summary.txt b/extra/literals/summary.txt new file mode 100644 index 0000000000..dfeb9fe797 --- /dev/null +++ b/extra/literals/summary.txt @@ -0,0 +1 @@ +Expression interpolation into sequence literals diff --git a/extra/literals/tags.txt b/extra/literals/tags.txt new file mode 100644 index 0000000000..71c0ff7282 --- /dev/null +++ b/extra/literals/tags.txt @@ -0,0 +1 @@ +syntax diff --git a/extra/sequences/n-based/authors.txt b/extra/sequences/n-based/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/sequences/n-based/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/sequences/n-based/n-based-docs.factor b/extra/sequences/n-based/n-based-docs.factor new file mode 100644 index 0000000000..ca5ac57cec --- /dev/null +++ b/extra/sequences/n-based/n-based-docs.factor @@ -0,0 +1,66 @@ +! (c)2008 Joe Groff, see BSD license etc. +USING: help.markup help.syntax kernel math multiline sequences ; +IN: sequences.n-based + +HELP: +{ $values { "seq" sequence } { "base" integer } { "n-based-assoc" n-based-assoc } } +{ $description "Wraps " { $snippet "seq" } " in an " { $link n-based-assoc } " wrapper." } +{ $examples +{ $example <" +USING: assocs prettyprint kernel sequences.n-based ; +IN: scratchpad + +: months + { + "January" + "February" + "March" + "April" + "May" + "June" + "July" + "August" + "September" + "October" + "November" + "December" + } 1 ; + +10 months at . +"> "\"October\"" } } ; + +HELP: n-based-assoc +{ $class-description "An adaptor class that allows a sequence to be treated as an assoc with non-zero-based keys." } +{ $examples +{ $example <" +USING: assocs prettyprint kernel sequences.n-based ; +IN: scratchpad + +: months + { + "January" + "February" + "March" + "April" + "May" + "June" + "July" + "August" + "September" + "October" + "November" + "December" + } 1 ; + +10 months at . +"> "\"October\"" } } ; + +{ n-based-assoc } related-words + +ARTICLE: "sequences.n-based" "sequences.n-based" +"The " { $vocab-link "sequences.n-based" } " vocabulary provides a sequence adaptor that allows a sequence to be treated as an assoc with non-zero-based keys." +{ $subsection n-based-assoc } +{ $subsection } +; + +ABOUT: "sequences.n-based" diff --git a/extra/sequences/n-based/n-based-tests.factor b/extra/sequences/n-based/n-based-tests.factor new file mode 100644 index 0000000000..7ee5bd649f --- /dev/null +++ b/extra/sequences/n-based/n-based-tests.factor @@ -0,0 +1,64 @@ +! (c)2008 Joe Groff, see BSD license etc. +USING: kernel accessors assocs +sequences sequences.n-based tools.test ; +IN: sequences.n-based.tests + +: months + V{ + "January" + "February" + "March" + "April" + "May" + "June" + "July" + "August" + "September" + "October" + "November" + "December" + } clone 1 ; inline + +[ "December" t ] +[ 12 months at* ] unit-test +[ f f ] +[ 13 months at* ] unit-test +[ f f ] +[ 0 months at* ] unit-test + +[ 12 ] [ months assoc-size ] unit-test + +[ { + { 1 "January" } + { 2 "February" } + { 3 "March" } + { 4 "April" } + { 5 "May" } + { 6 "June" } + { 7 "July" } + { 8 "August" } + { 9 "September" } + { 10 "October" } + { 11 "November" } + { 12 "December" } +} ] [ months >alist ] unit-test + +[ V{ + "January" + "February" + "March" + "April" + "May" + "June" + "July" + "August" + "September" + "October" + "November" + "December" + "Smarch" +} ] [ "Smarch" 13 months [ set-at ] keep seq>> ] unit-test + +[ V{ } ] [ months [ clear-assoc ] keep seq>> ] unit-test + + diff --git a/extra/sequences/n-based/n-based.factor b/extra/sequences/n-based/n-based.factor new file mode 100644 index 0000000000..78fe851389 --- /dev/null +++ b/extra/sequences/n-based/n-based.factor @@ -0,0 +1,31 @@ +! (c)2008 Joe Groff, see BSD license etc. +USING: accessors assocs kernel math math.ranges sequences +sequences.private ; +IN: sequences.n-based + +TUPLE: n-based-assoc seq base ; +C: n-based-assoc + +> - ] [ nip seq>> ] 2bi ; +: n-based-keys ( assoc -- range ) + [ base>> ] [ assoc-size ] bi 1 ; + +PRIVATE> + +INSTANCE: n-based-assoc assoc +M: n-based-assoc at* ( key assoc -- value ? ) + n-based@ 2dup bounds-check? + [ nth-unsafe t ] [ 2drop f f ] if ; +M: n-based-assoc assoc-size ( assoc -- size ) + seq>> length ; +M: n-based-assoc >alist ( assoc -- alist ) + [ n-based-keys ] [ seq>> ] bi zip ; +M: n-based-assoc set-at ( value key assoc -- ) + n-based@ set-nth ; +M: n-based-assoc delete-at ( key assoc -- ) + [ f ] 2dip n-based@ set-nth ; +M: n-based-assoc clear-assoc ( assoc -- ) + seq>> delete-all ; diff --git a/extra/sequences/n-based/summary.txt b/extra/sequences/n-based/summary.txt new file mode 100644 index 0000000000..a8097a3131 --- /dev/null +++ b/extra/sequences/n-based/summary.txt @@ -0,0 +1 @@ +Sequence adaptor to treat a sequence as an n-based assoc diff --git a/extra/sequences/n-based/tags.txt b/extra/sequences/n-based/tags.txt new file mode 100644 index 0000000000..1ee19c1323 --- /dev/null +++ b/extra/sequences/n-based/tags.txt @@ -0,0 +1,2 @@ +sequences +assocs