Merge branch 'master' of git://repo.or.cz/factor/jcg

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
 
+<PRIVATE
 : width>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 )
+: render-cairo ( gadget -- alien )
-    dup dim>> first2 over width>stride
+    [
-    [ * nip <byte-array> dup CAIRO_FORMAT_ARGB32 ] 
+        image-dims
+        [ image-buffer dup CAIRO_FORMAT_ARGB32 ] 
         [ cairo_image_surface_create_for_data ] 3bi
-    rot '[ _ render-cairo* ] with-cairo-from-surface ; inline
+    ] [ '[ _ 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
+    [
+        [ dim>> ] [ render-cairo &free ] bi
         origin get first2 glRasterPos2i
         1.0 -1.0 glPixelZoom
         [ first2 GL_BGRA GL_UNSIGNED_BYTE ] dip
-    glDrawPixels ;
+        glDrawPixels
+    ] with-destructors ;
 
 : copy-surface ( surface -- )
     cr swap 0 0 cairo_set_source_surface

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:

extra/literals/authors.txt

@@ -0,0 +1 @@
+Joe Groff

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"

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

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

extra/literals/summary.txt

@@ -0,0 +1 @@
+Expression interpolation into sequence literals

extra/literals/tags.txt

@@ -0,0 +1 @@
+syntax

extra/sequences/n-based/authors.txt

@@ -0,0 +1 @@
+Joe Groff

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: <n-based-assoc>
+{ $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 <n-based-assoc> ;
+
+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 <n-based-assoc> ;
+
+10 months at .
+"> "\"October\"" } } ;
+
+{ n-based-assoc <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 <n-based-assoc> }
+;
+
+ABOUT: "sequences.n-based"

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 <n-based-assoc> ; 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
+
+

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> n-based-assoc
+
+<PRIVATE
+
+: n-based@ ( key assoc -- n seq )
+    [ base>> - ] [ nip seq>> ] 2bi ;
+: n-based-keys ( assoc -- range )
+    [ base>> ] [ assoc-size ] bi 1 <range> ;
+
+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 ;

extra/sequences/n-based/summary.txt

@@ -0,0 +1 @@
+Sequence adaptor to treat a sequence as an n-based assoc

extra/sequences/n-based/tags.txt

@@ -0,0 +1,2 @@
+sequences
+assocs