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

diff --git a/core/bit-arrays/bit-arrays-docs.factor b/core/bit-arrays/bit-arrays-docs.factor
index f804ed21f429fb24eefa90f5750ac1925f795b6b..6f3afe08675cb86a7d57a8d7ae048d3ff6ac903e 100644 (file)
--- a/core/bit-arrays/bit-arrays-docs.factor
+++ b/core/bit-arrays/bit-arrays-docs.factor
@@ -1,5 +1,5 @@
 USING: arrays help.markup help.syntax kernel
-kernel.private prettyprint strings vectors sbufs ;
+kernel.private math prettyprint strings vectors sbufs ;
 IN: bit-arrays
 
 ARTICLE: "bit-arrays" "Bit arrays"
@@ -17,7 +17,10 @@ $nl
 { $subsection <bit-array> }
 "Efficiently setting and clearing all bits in a bit array:"
 { $subsection set-bits }
-{ $subsection clear-bits } ;
+{ $subsection clear-bits }
+"Converting between unsigned integers and their binary representation:"
+{ $subsection integer>bit-array }
+{ $subsection bit-array>integer } ;
 
 ABOUT: "bit-arrays"
 
@@ -47,3 +50,13 @@ HELP: set-bits
     { $code "[ drop t ] change-each" }
 }
 { $side-effects "bit-array" } ;
+
+HELP: integer>bit-array
+{ $values { "integer" integer } { "bit-array" bit-array } }
+{ $description "Outputs a freshly-allocated bit array whose elements correspond to the bits in the binary representation of the given unsigned integer value." }
+{ $notes "The bits of the integer are stored in the resulting bit array in order of ascending significance, least significant bit first. This word will fail if passed a negative integer. If you want the two's-complement binary representation of a negative number, use " { $link bitnot } " to get the complement of the number first. This word works with fixnums or bignums of any size; it is not limited by fixnum size or machine word size." } ;
+
+HELP: bit-array>integer
+{ $values { "bit-array" bit-array } { "integer" integer } }
+{ $description "Outputs the unsigned integer whose binary representation corresponds to the contents of the given bit array." }
+{ $notes "The bits of the integer are taken from the bit array in order of ascending significance, least significant bit first. This word is able to return fixnums or bignums of any size; it is not limited by fixnum size or machine word size." } ;

diff --git a/core/bit-arrays/bit-arrays-tests.factor b/core/bit-arrays/bit-arrays-tests.factor
index e28c16c3c25c5acd496b9ad4f6e171996b031714..03961c2db6678180f9ab793bd627500c89121aba 100755 (executable)
--- a/core/bit-arrays/bit-arrays-tests.factor
+++ b/core/bit-arrays/bit-arrays-tests.factor
@@ -52,3 +52,23 @@ IN: bit-arrays.tests
 [ ?{ t t } ] [ 2 ?{ t t f t f t f t t t f t } resize-bit-array ] unit-test
 
 [ -10 ?{ } resize-bit-array ] must-fail
+
+[ -1 integer>bit-array ] must-fail
+[ ?{ f t } ] [ 2 integer>bit-array ] unit-test
+[ ?{ t t t t t t t t t } ] [ 511 integer>bit-array ] unit-test
+[ ?{ 
+    t t t t t t t t   t t t t t t t t   t t t t t t t t  t t t t t t t t
+    t t t t t t t t   t t t t t t t t   t t t t t t t t  t t t t t t t t
+    t t t t t t t t   t t t t t t t t   t t t t t t t t  t t t t t t t t
+    t t t t t t t t   t t t t t t t t   t t t t t t t t  t t t t t t t t
+} ] [
+    HEX: ffffffffffffffffffffffffffffffff integer>bit-array
+] unit-test
+
+[ 14 ] [ ?{ f t t t } bit-array>integer ] unit-test
+[ HEX: ffffffffffffffffffffffffffffffff ] [ ?{
+    t t t t t t t t   t t t t t t t t   t t t t t t t t  t t t t t t t t
+    t t t t t t t t   t t t t t t t t   t t t t t t t t  t t t t t t t t
+    t t t t t t t t   t t t t t t t t   t t t t t t t t  t t t t t t t t
+    t t t t t t t t   t t t t t t t t   t t t t t t t t  t t t t t t t t
+} bit-array>integer ] unit-test

diff --git a/core/bit-arrays/bit-arrays.factor b/core/bit-arrays/bit-arrays.factor
index ffb9f5d195d5d9b637a497b51aa51ab5c8136fa1..4446bb5556356ccddfbedf0ef416a961f2900d60 100755 (executable)
--- a/core/bit-arrays/bit-arrays.factor
+++ b/core/bit-arrays/bit-arrays.factor
@@ -51,4 +51,17 @@ M: bit-array equal?
 M: bit-array resize
     resize-bit-array ;
 
+: integer>bit-array ( int -- bit-array ) 
+    [ log2 1+ <bit-array> 0 ] keep
+    [ dup zero? not ] [
+        [ -8 shift ] [ 255 bitand ] bi
+        -roll [ [ set-alien-unsigned-1 ] 2keep 1+ ] dip
+    ] [ ] while
+    2drop ;
+
+: bit-array>integer ( bit-array -- int )
+    dup >r length 7 + n>byte 0 r> [
+        swap alien-unsigned-1 swap 8 shift bitor
+    ] curry reduce ;
+
 INSTANCE: bit-array sequence

diff --git a/extra/cocoa/application/application.factor b/extra/cocoa/application/application.factor
index 90159c1656afeba62c2b8d1070c185df2f2d0721..e23730274490f40c3588aa9697046b02c4e49c47 100755 (executable)
--- a/extra/cocoa/application/application.factor
+++ b/extra/cocoa/application/application.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2006, 2007 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien io kernel namespaces core-foundation
+USING: alien alien.syntax io kernel namespaces core-foundation
 core-foundation.run-loop cocoa.messages cocoa cocoa.classes
 cocoa.runtime sequences threads debugger init inspector
 kernel.private ;
@@ -19,6 +19,8 @@ IN: cocoa.application
 
 : NSApp ( -- app ) NSApplication -> sharedApplication ;
 
+FUNCTION: void NSBeep ( ) ;
+
 : with-cocoa ( quot -- )
     [ NSApp drop call ] with-autorelease-pool ;
 

diff --git a/extra/ui/backend/backend.factor b/extra/ui/backend/backend.factor
index 7ca09b89b47206a10ce583a4f127220dfe6bd9da..0840d07cbc12fb0c9788a15f187d26e3bde869b1 100755 (executable)
--- a/extra/ui/backend/backend.factor
+++ b/extra/ui/backend/backend.factor
@@ -23,6 +23,8 @@ HOOK: select-gl-context ui-backend ( handle -- )
 
 HOOK: flush-gl-context ui-backend ( handle -- )
 
+HOOK: beep ui-backend ( -- )
+
 : with-gl-context ( handle quot -- )
     swap [ select-gl-context call ] keep
     glFlush flush-gl-context gl-error ; inline

diff --git a/extra/ui/cocoa/cocoa.factor b/extra/ui/cocoa/cocoa.factor
index d1b7f22b4166d968f60022b00acc9360657b751f..0db38e5eca0866db63a6db26dfba6b5c303a5aae 100755 (executable)
--- a/extra/ui/cocoa/cocoa.factor
+++ b/extra/ui/cocoa/cocoa.factor
@@ -101,6 +101,9 @@ M: cocoa-ui-backend select-gl-context ( handle -- )
 M: cocoa-ui-backend flush-gl-context ( handle -- )
     handle-view -> openGLContext -> flushBuffer ;
 
+M: cocoa-ui-backend beep ( -- )
+    NSBeep ;
+
 SYMBOL: cocoa-init-hook
 
 M: cocoa-ui-backend ui

diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor
index 4a9417fc6b5f65bddf27f215efffdded427e940f..3fc5d4abcd8fac94968ff0095a5fe47b507d6fd4 100755 (executable)
--- a/extra/ui/windows/windows.factor
+++ b/extra/ui/windows/windows.factor
@@ -506,6 +506,9 @@ M: windows-ui-backend ui
         ] [ cleanup-win32-ui ] [ ] cleanup
     ] ui-running ;
 
+M: windows-ui-backend beep ( -- )
+    0 MessageBeep drop ;
+
 windows-ui-backend ui-backend set-global
 
 [ "ui" ] main-vocab-hook set-global

diff --git a/extra/ui/x11/x11.factor b/extra/ui/x11/x11.factor
index 50d383e6b8b7cba364b20a045bec20d2ee0f1a9e..1ba0c96a4d2fa18e51797df960de188da845d232 100755 (executable)
--- a/extra/ui/x11/x11.factor
+++ b/extra/ui/x11/x11.factor
@@ -257,6 +257,9 @@ M: x11-ui-backend ui ( -- )
         ] with-x
     ] ui-running ;
 
+M: x11-ui-backend beep ( -- )
+    dpy 100 XBell drop ;
+
 x11-ui-backend ui-backend set-global
 
 [ "DISPLAY" system:os-env "ui" "listener" ? ]

diff --git a/framebuffers-docs.factor b/framebuffers-docs.factor
new file mode 100644 (file)
index 0000000..c5507dc
--- /dev/null
+++ b/framebuffers-docs.factor
@@ -0,0 +1,35 @@
+USING: help.markup help.syntax io kernel math quotations
+opengl.gl multiline assocs ;
+IN: opengl.framebuffers
+
+HELP: gen-framebuffer
+{ $values { "id" integer } }
+{ $description "Wrapper for " { $link glGenFramebuffersEXT } " to handle the common case of generating a single framebuffer ID." } ;
+
+HELP: gen-renderbuffer
+{ $values { "id" integer } }
+{ $description "Wrapper for " { $link glGenRenderbuffersEXT } " to handle the common case of generating a single render buffer ID." } ;
+
+HELP: delete-framebuffer
+{ $values { "id" integer } }
+{ $description "Wrapper for " { $link glDeleteFramebuffersEXT } " to handle the common case of deleting a single framebuffer ID." } ;
+
+HELP: delete-renderbuffer
+{ $values { "id" integer } }
+{ $description "Wrapper for " { $link glDeleteRenderbuffersEXT } " to handle the common case of deleting a single render buffer ID." } ;
+
+{ gen-framebuffer delete-framebuffer } related-words
+{ gen-renderbuffer delete-renderbuffer } related-words
+
+HELP: framebuffer-incomplete?
+{ $values { "status/f" "The framebuffer error code, or " { $snippet "f" } " if the framebuffer is render-complete." } }
+{ $description "Checks the framebuffer currently bound by " { $link glBindFramebufferEXT } " or " { $link with-framebuffer } " to see if it is incomplete, i.e., it is not ready to be rendered to." } ;
+
+HELP: check-framebuffer
+{ $description "Checks the framebuffer currently bound by " { $link glBindFramebufferEXT } " or " { $link with-framebuffer } " with " { $link framebuffer-incomplete? } ", and throws a descriptive error if the framebuffer is incomplete." } ;
+
+HELP: with-framebuffer
+{ $values { "id" "The id of a framebuffer object." } { "quot" "a quotation" } }
+{ $description "Binds framebuffer " { $snippet "id" } " in the dynamic extent of " { $snippet "quot" } ", restoring the window framebuffer when finished." } ;
+
+ABOUT: "gl-utilities"
\ No newline at end of file