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

basis/alien/arrays/arrays-docs.factor

@@ -1,12 +0,0 @@
-USING: help.syntax help.markup byte-arrays alien.c-types alien.data ;
-IN: alien.arrays
-
-ARTICLE: "c-arrays" "C arrays"
-"C arrays are allocated in the same manner as other C data; see " { $link "c-byte-arrays" } " and " { $link "malloc" } "."
-$nl
-"C type specifiers for array types are documented in " { $link "c-types-specs" } "."
-$nl
-"Specialized sequences are provided for accessing memory as an array of primitive type values. These sequences are implemented in the " { $vocab-link "specialized-arrays" } " vocabulary set. They can also be loaded and constructed through their primitive C types:"
-{ $subsection require-c-array }
-{ $subsection <c-array> }
-{ $subsection <c-direct-array> } ;

basis/alien/c-types/c-types-docs.factor

@@ -10,7 +10,7 @@ HELP: byte-length
 { $contract "Outputs the size of the byte array, struct, or specialized array data in bytes." } ;
 
 HELP: heap-size
-{ $values { "type" string } { "size" math:integer } }
+{ $values { "name" "a C type name" } { "size" math:integer } }
 { $description "Outputs the number of bytes needed for a heap-allocated value of this C type." }
 { $examples
     { $example "USING: alien alien.c-types prettyprint ;\nint heap-size ." "4" }
@@ -18,16 +18,16 @@ HELP: heap-size
 { $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
 
 HELP: stack-size
-{ $values { "type" string } { "size" math:integer } }
+{ $values { "name" "a C type name" } { "size" math:integer } }
 { $description "Outputs the number of bytes to reserve on the C stack by a value of this C type. In most cases this is equal to " { $link heap-size } ", except on some platforms where C structs are passed by invisible reference, in which case a C struct type only uses as much space as a pointer on the C stack." }
 { $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
 
 HELP: <c-type>
-{ $values { "type" hashtable } }
+{ $values { "c-type" c-type } }
 { $description "Creates a prototypical C type. User code should use higher-level facilities to define C types; see " { $link "c-data" } "." } ;
 
 HELP: no-c-type
-{ $values { "type" string } }
+{ $values { "name" "a C type name" } }
 { $description "Throws a " { $link no-c-type } " error." }
 { $error-description "Thrown by " { $link c-type } " if a given string does not name a C type. When thrown during compile time, indicates a typo in an " { $link alien-invoke } " or " { $link alien-callback } " form." } ;
 
@@ -35,32 +35,32 @@ HELP: c-types
 { $var-description "Global variable holding a hashtable mapping C type names to C types. Use the " { $link c-type } " word to look up C types." } ;
 
 HELP: c-type
-{ $values { "name" string } { "type" hashtable } }
+{ $values { "name" "a C type" } { "c-type" c-type } }
 { $description "Looks up a C type by name." }
 { $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
 
 HELP: c-getter
-{ $values { "name" string } { "quot" { $quotation "( c-ptr n -- obj )" } } }
+{ $values { "name" "a C type" } { "quot" { $quotation "( c-ptr n -- obj )" } } }
 { $description "Outputs a quotation which reads values of this C type from a C structure." }
 { $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
 
 HELP: c-setter
-{ $values { "name" string } { "quot" { $quotation "( obj c-ptr n -- )" } } }
+{ $values { "name" "a C type" } { "quot" { $quotation "( obj c-ptr n -- )" } } }
 { $description "Outputs a quotation which writes values of this C type to a C structure." }
 { $errors "Throws an error if the type does not exist." } ;
 
 HELP: box-parameter
-{ $values { "n" math:integer } { "ctype" string } }
+{ $values { "n" math:integer } { "c-type" "a C type" } }
 { $description "Generates code for converting a C value stored at  offset " { $snippet "n" } " from the top of the stack into a Factor object to be pushed on the data stack." }
 { $notes "This is an internal word used by the compiler when compiling callbacks." } ;
 
 HELP: box-return
-{ $values { "ctype" string } }
+{ $values { "c-type" "a C type" } }
 { $description "Generates code for converting a C value stored in return registers into a Factor object to be pushed on the data stack." }
 { $notes "This is an internal word used by the compiler when compiling alien calls." } ;
 
 HELP: unbox-return
-{ $values { "ctype" string } }
+{ $values { "c-type" "a C type" } }
 { $description "Generates code for converting a Factor value on the data stack into a C value to be stored in the return registers." }
 { $notes "This is an internal word used by the compiler when compiling callbacks." } ;
 

basis/alien/c-types/c-types.factor

@@ -39,8 +39,8 @@ unboxer
 { rep initial: int-rep }
 stack-align? ;
 
-: <c-type> ( -- type )
+: <c-type> ( -- c-type )
-    \ c-type new ;
+    \ c-type new ; inline
 
 SYMBOL: c-types
 
@@ -56,13 +56,14 @@ PREDICATE: c-type-word < word
 UNION: c-type-name string word ;
 
 ! C type protocol
-GENERIC: c-type ( name -- type ) foldable
+GENERIC: c-type ( name -- c-type ) foldable
 
 GENERIC: resolve-pointer-type ( name -- c-type )
 
 M: word resolve-pointer-type
     dup "pointer-c-type" word-prop
     [ ] [ drop void* ] ?if ;
+
 M: string resolve-pointer-type
     dup "*" append dup c-types get at
     [ nip ] [
@@ -71,14 +72,14 @@ M: string resolve-pointer-type
         [ resolve-pointer-type ] [ drop void* ] if
     ] if ;
 
-: resolve-typedef ( name -- type )
+: resolve-typedef ( name -- c-type )
     dup c-type-name? [ c-type ] when ;
 
-: parse-array-type ( name -- dims type )
+: parse-array-type ( name -- dims c-type )
     "[" split unclip
     [ [ "]" ?tail drop string>number ] map ] dip ;
 
-M: string c-type ( name -- type )
+M: string c-type ( name -- c-type )
     CHAR: ] over member? [
         parse-array-type prefix
     ] [
@@ -93,7 +94,7 @@ M: word c-type
 : void? ( c-type -- ? )
     { void "void" } member? ;
 
-GENERIC: c-struct? ( type -- ? )
+GENERIC: c-struct? ( c-type -- ? )
 
 M: object c-struct?
     drop f ;
@@ -169,33 +170,33 @@ M: c-type c-type-stack-align? stack-align?>> ;
 
 M: c-type-name c-type-stack-align? c-type c-type-stack-align? ;
 
-: c-type-box ( n type -- )
+: c-type-box ( n c-type -- )
     [ c-type-rep ] [ c-type-boxer [ "No boxer" throw ] unless* ] bi
     %box ;
 
-: c-type-unbox ( n ctype -- )
+: c-type-unbox ( n c-type -- )
     [ c-type-rep ] [ c-type-unboxer [ "No unboxer" throw ] unless* ] bi
     %unbox ;
 
-GENERIC: box-parameter ( n ctype -- )
+GENERIC: box-parameter ( n c-type -- )
 
 M: c-type box-parameter c-type-box ;
 
 M: c-type-name box-parameter c-type box-parameter ;
 
-GENERIC: box-return ( ctype -- )
+GENERIC: box-return ( c-type -- )
 
 M: c-type box-return f swap c-type-box ;
 
 M: c-type-name box-return c-type box-return ;
 
-GENERIC: unbox-parameter ( n ctype -- )
+GENERIC: unbox-parameter ( n c-type -- )
 
 M: c-type unbox-parameter c-type-unbox ;
 
 M: c-type-name unbox-parameter c-type unbox-parameter ;
 
-GENERIC: unbox-return ( ctype -- )
+GENERIC: unbox-return ( c-type -- )
 
 M: c-type unbox-return f swap c-type-unbox ;
 
@@ -203,13 +204,13 @@ M: c-type-name unbox-return c-type unbox-return ;
 
 : little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
 
-GENERIC: heap-size ( type -- size ) foldable
+GENERIC: heap-size ( name -- size ) foldable
 
 M: c-type-name heap-size c-type heap-size ;
 
 M: abstract-c-type heap-size size>> ;
 
-GENERIC: stack-size ( type -- size ) foldable
+GENERIC: stack-size ( name -- size ) foldable
 
 M: c-type-name stack-size c-type stack-size ;
 
@@ -236,7 +237,7 @@ MIXIN: value-type
         [ "Cannot write struct fields with this type" throw ]
     ] unless* ;
 
-: array-accessor ( type quot -- def )
+: array-accessor ( c-type quot -- def )
     [
         \ swap , [ heap-size , [ * >fixnum ] % ] [ % ] bi*
     ] [ ] make ;
@@ -262,19 +263,19 @@ M: word typedef ( old new -- )
 
 TUPLE: long-long-type < c-type ;
 
-: <long-long-type> ( -- type )
+: <long-long-type> ( -- c-type )
     long-long-type new ;
 
-M: long-long-type unbox-parameter ( n type -- )
+M: long-long-type unbox-parameter ( n c-type -- )
     c-type-unboxer %unbox-long-long ;
 
-M: long-long-type unbox-return ( type -- )
+M: long-long-type unbox-return ( c-type -- )
     f swap unbox-parameter ;
 
-M: long-long-type box-parameter ( n type -- )
+M: long-long-type box-parameter ( n c-type -- )
     c-type-boxer %box-long-long ;
 
-M: long-long-type box-return ( type -- )
+M: long-long-type box-return ( c-type -- )
     f swap box-parameter ;
 
 : define-deref ( name -- )
@@ -286,13 +287,13 @@ M: long-long-type box-return ( type -- )
     [ dup c-setter '[ _ heap-size <byte-array> [ 0 @ ] keep ] ] bi
     (( value -- c-ptr )) define-inline ;
 
-: define-primitive-type ( type name -- )
+: define-primitive-type ( c-type name -- )
     [ typedef ]
     [ name>> define-deref ]
     [ name>> define-out ]
     tri ;
 
-: if-void ( type true false -- )
+: if-void ( c-type true false -- )
     pick void? [ drop nip call ] [ nip call ] if ; inline
 
 CONSTANT: primitive-types

basis/alien/data/data-docs.factor

@@ -1,6 +1,7 @@
-USING: alien alien.c-types help.syntax help.markup libc kernel.private
+USING: alien alien.c-types help.syntax help.markup libc
-byte-arrays math strings hashtables alien.syntax alien.strings sequences
+kernel.private byte-arrays math strings hashtables alien.syntax
-io.encodings.string debugger destructors vocabs.loader ;
+alien.strings sequences io.encodings.string debugger destructors
+vocabs.loader classes.struct ;
 IN: alien.data
 
 HELP: <c-array>
@@ -26,7 +27,7 @@ HELP: byte-array>memory
 { $warning "This word is unsafe. Improper use can corrupt memory." } ;
 
 HELP: malloc-array
-{ $values { "n" "a non-negative integer" } { "type" "a C type" } { "alien" alien } }
+{ $values { "n" "a non-negative integer" } { "type" "a C type" } { "array" "a specialized array" } }
 { $description "Allocates an unmanaged memory block large enough to hold " { $snippet "n" } " values of a C type, then wraps the memory in a sequence object using " { $link <c-direct-array> } "." }
 { $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
 { $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
@@ -53,8 +54,8 @@ ARTICLE: "malloc" "Manual memory management"
 $nl
 "Allocating a C datum with a fixed address:"
 { $subsection malloc-object }
-{ $subsection malloc-array }
 { $subsection malloc-byte-array }
+{ $subsection malloc-file-contents }
 "There is a set of words in the " { $vocab-link "libc" } " vocabulary which directly call C standard library memory management functions:"
 { $subsection malloc }
 { $subsection calloc }
@@ -73,26 +74,31 @@ $nl
 "You can copy a byte array to memory unsafely:"
 { $subsection byte-array>memory } ;
 
-
+ARTICLE: "c-pointers" "Passing pointers to C functions"
-ARTICLE: "c-byte-arrays" "Passing data in byte arrays"
+"The following Factor objects may be passed to C function parameters with pointer types:"
-"Instances of the " { $link byte-array } " class can be passed to C functions; the C function receives a pointer to the first element of the array."
+{ $list
-$nl
+    { "Instances of " { $link alien } "." }
-"Byte arrays can be allocated directly with a byte count using the " { $link <byte-array> } " word. However in most cases, instead of computing a size in bytes directly, it is easier to use a higher-level word which expects C type and outputs a byte array large enough to hold that type:"
+    { "Instances of " { $link f } "; this is interpreted as a null pointer." }
-{ $subsection <c-object> }
+    { "Instances of " { $link byte-array } "; the C function receives a pointer to the first element of the array." }
-{ $subsection <c-array> }
+    { "Any data type which defines a method on " { $link >c-ptr } " that returns an instance of one of the above. This includes " { $link "classes.struct" } " and " { $link "specialized-arrays" } "." } 
+}
+"The class of primitive C pointer types:"
+{ $subsection c-ptr }
+"A generic word for converting any object to a C pointer; user-defined types may add methods to this generic word:"
+{ $subsection >c-ptr }
+"More about the " { $link alien } " type:"
+{ $subsection "aliens" }
 { $warning
-"The Factor garbage collector can move byte arrays around, and code passing byte arrays to C must obey important guidelines. See " { $link "byte-arrays-gc" } "." }
+"The Factor garbage collector can move byte arrays around, and code passing byte arrays, or objects backed by byte arrays, must obey important guidelines. See " { $link "byte-arrays-gc" } "." } ;
-{ $see-also "c-arrays" } ;
 
 ARTICLE: "c-data" "Passing data between Factor and C"
 "Two defining characteristics of Factor are dynamic typing and automatic memory management, which are somewhat incompatible with the machine-level data model exposed by C. Factor's C library interface defines its own set of C data types, distinct from Factor language types, together with automatic conversion between Factor values and C types. For example, C integer types must be declared and are fixed-width, whereas Factor supports arbitrary-precision integers."
 $nl
 "Furthermore, Factor's garbage collector can move objects in memory; for a discussion of the consequences, see " { $link "byte-arrays-gc" } "."
 { $subsection "c-types-specs" }
-{ $subsection "c-byte-arrays" }
+{ $subsection "c-pointers" }
 { $subsection "malloc" }
 { $subsection "c-strings" }
-{ $subsection "c-arrays" }
 { $subsection "c-out-params" }
 "Important guidelines for passing data in byte arrays:"
 { $subsection "byte-arrays-gc" }
@@ -100,12 +106,10 @@ $nl
 { $subsection POSTPONE: C-ENUM: }
 "C types can be aliased for convenience and consitency with native library documentation:"
 { $subsection POSTPONE: TYPEDEF: }
-"New C types can be defined:"
-{ $subsection "c-structs" }
-{ $subsection "c-unions" }
 "A utility for defining " { $link "destructors" } " for deallocating memory:"
 { $subsection "alien.destructors" }
-{ $see-also "aliens" } ;
+"C struct and union types can be defined with " { $link POSTPONE: STRUCT: } " and " { $link POSTPONE: UNION: } ". See " { $link "classes.struct" } " for details. For passing arrays to and from C, use the " { $link "specialized-arrays" } " vocabulary." ;
+
 HELP: malloc-string
 { $values { "string" string } { "encoding" "an encoding descriptor" } { "alien" c-ptr } }
 { $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated unmanaged memory block." }

basis/alien/data/data.factor

@@ -29,7 +29,7 @@ GENERIC: <c-direct-array> ( alien len c-type -- array )
 M: c-type-name <c-direct-array>
     c-direct-array-constructor execute( alien len -- array ) ; inline
 
-: malloc-array ( n type -- alien )
+: malloc-array ( n type -- array )
     [ heap-size calloc ] [ <c-direct-array> ] 2bi ; inline
 
 : (malloc-array) ( n type -- alien )

basis/alien/structs/authors.txt

@@ -1 +0,0 @@
-Slava Pestov

basis/alien/structs/fields/fields.factor

@@ -1,45 +0,0 @@
-! Copyright (C) 2005, 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel kernel.private math namespaces
-make sequences strings words effects combinators alien.c-types ;
-IN: alien.structs.fields
-
-TUPLE: field-spec name offset type reader writer ;
-
-: reader-word ( class name vocab -- word )
-    [ "-" glue ] dip create dup make-deprecated ;
-
-: writer-word ( class name vocab -- word )
-    [ [ swap "set-" % % "-" % % ] "" make ] dip create dup make-deprecated ;
-
-: <field-spec> ( struct-name vocab type field-name -- spec )
-    field-spec new
-        0 >>offset
-        swap >>name
-        swap >>type
-        3dup name>> swap reader-word >>reader
-        3dup name>> swap writer-word >>writer
-    2nip ;
-
-: align-offset ( offset type -- offset )
-    c-type-align align ;
-
-: struct-offsets ( specs -- size )
-    0 [
-        [ type>> align-offset ] keep
-        [ (>>offset) ] [ type>> heap-size + ] 2bi
-    ] reduce ;
-
-: define-struct-slot-word ( word quot spec effect -- )
-    [ offset>> prefix ] dip define-inline ;
-
-: define-getter ( spec -- )
-    [ reader>> ] [ type>> c-type-getter-boxer ] [ ] tri
-    (( c-ptr -- value )) define-struct-slot-word ;
-
-: define-setter ( spec -- )
-    [ writer>> ] [ type>> c-setter ] [ ] tri
-    (( value c-ptr -- )) define-struct-slot-word ;
-
-: define-field ( spec -- )
-    [ define-getter ] [ define-setter ] bi ;

basis/alien/structs/fields/summary.txt

@@ -1 +0,0 @@
-Struct field implementation and reflection support

basis/alien/structs/structs-docs.factor

@@ -1,33 +0,0 @@
-USING: alien.c-types alien.data strings help.markup help.syntax alien.syntax
-sequences io arrays kernel words assocs namespaces ;
-IN: alien.structs
-
-ARTICLE: "c-structs" "C structure types"
-"A " { $snippet "struct" } " in C is essentially a block of memory with the value of each structure field stored at a fixed offset from the start of the block. The C library interface provides some utilities to define words which read and write structure fields given a base address."
-{ $subsection POSTPONE: C-STRUCT: }
-"Great care must be taken when working with C structures since no type or bounds checking is possible."
-$nl
-"An example:"
-{ $code
-    "C-STRUCT: XVisualInfo"
-    "    { \"Visual*\" \"visual\" }"
-    "    { \"VisualID\" \"visualid\" }"
-    "    { \"int\" \"screen\" }"
-    "    { \"uint\" \"depth\" }"
-    "    { \"int\" \"class\" }"
-    "    { \"ulong\" \"red_mask\" }"
-    "    { \"ulong\" \"green_mask\" }"
-    "    { \"ulong\" \"blue_mask\" }"
-    "    { \"int\" \"colormap_size\" }"
-    "    { \"int\" \"bits_per_rgb\" } ;"
-}
-"C structure objects can be allocated by calling " { $link <c-object> } " or " { $link malloc-object } "."
-$nl
-"Arrays of C structures can be created with the " { $vocab-link "specialized-arrays" } " vocabulary." ;
-
-ARTICLE: "c-unions" "C unions"
-"A " { $snippet "union" } " in C defines a type large enough to hold its largest member. This is usually used to allocate a block of memory which can hold one of several types of values."
-{ $subsection POSTPONE: C-UNION: }
-"C union objects can be allocated by calling " { $link <c-object> } " or " { $link malloc-object } "."
-$nl
-"Arrays of C unions can be created with the " { $vocab-link "specialized-arrays" } " vocabulary." ;

basis/alien/structs/structs-tests.factor

@@ -1,59 +0,0 @@
-USING: alien alien.syntax alien.c-types alien.data kernel tools.test
-sequences system libc words vocabs namespaces layouts ;
-IN: alien.structs.tests
-
-C-STRUCT: bar
-    { "int" "x" }
-    { { "int" 8 } "y" } ;
-
-[ 36 ] [ "bar" heap-size ] unit-test
-[ t ] [ \ <displaced-alien> "bar" c-type-getter memq? ] unit-test
-
-C-STRUCT: align-test
-    { "int" "x" }
-    { "double" "y" } ;
-
-os winnt? cpu x86? and [
-    [ 16 ] [ "align-test" heap-size ] unit-test
-    
-    cell 4 = [
-        C-STRUCT: one
-        { "long" "a" } { "double" "b" } { "int" "c" } ;
-    
-        [ 24 ] [ "one" heap-size ] unit-test
-    ] when
-] when
-
-CONSTANT: MAX_FOOS 30
-
-C-STRUCT: foox
-    { { "int" MAX_FOOS } "x" } ;
-
-[ 120 ] [ "foox" heap-size ] unit-test
-
-C-UNION: barx
-    { "int" MAX_FOOS }
-    "float" ;
-
-[ 120 ] [ "barx" heap-size ] unit-test
-
-"help" vocab [
-    "print-topic" "help" lookup "help" set
-    [ ] [ \ foox-x "help" get execute ] unit-test
-    [ ] [ \ set-foox-x "help" get execute ] unit-test
-] when
-
-C-STRUCT: nested
-    { "int" "x" } ;
-
-C-STRUCT: nested-2
-    { "nested" "y" } ;
-
-[ 4 ] [
-    "nested-2" <c-object>
-    "nested" <c-object>
-    4 over set-nested-x
-    over set-nested-2-y
-    nested-2-y
-    nested-x
-] unit-test

basis/alien/structs/structs.factor

@@ -1,71 +0,0 @@
-! Copyright (C) 2004, 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs generic hashtables kernel kernel.private
-math namespaces parser sequences strings words libc fry
-alien.c-types alien.structs.fields cpu.architecture math.order
-quotations byte-arrays ;
-IN: alien.structs
-
-TUPLE: struct-type < abstract-c-type fields return-in-registers? ;
-
-INSTANCE: struct-type value-type
-
-M: struct-type c-type ;
-
-M: struct-type c-type-stack-align? drop f ;
-
-: if-value-struct ( ctype true false -- )
-    [ dup value-struct? ] 2dip '[ drop void* @ ] if ; inline
-
-M: struct-type unbox-parameter
-    [ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ;
-
-M: struct-type box-parameter
-    [ %box-large-struct ] [ box-parameter ] if-value-struct ;
-
-: if-small-struct ( c-type true false -- ? )
-    [ dup return-struct-in-registers? ] 2dip '[ f swap @ ] if ; inline
-
-M: struct-type unbox-return
-    [ %unbox-small-struct ] [ %unbox-large-struct ] if-small-struct ;
-
-M: struct-type box-return
-    [ %box-small-struct ] [ %box-large-struct ] if-small-struct ;
-
-M: struct-type stack-size
-    [ heap-size ] [ stack-size ] if-value-struct ;
-
-M: struct-type c-struct? drop t ;
-
-: (define-struct) ( name size align fields class -- )
-    [ [ align ] keep ] 2dip new
-        byte-array >>class
-        byte-array >>boxed-class
-        swap >>fields
-        swap >>align
-        swap >>size
-        swap typedef ;
-
-: make-fields ( name vocab fields -- fields )
-    [ first2 <field-spec> ] with with map ;
-
-: compute-struct-align ( types -- n )
-    [ c-type-align ] [ max ] map-reduce ;
-
-: define-struct ( name vocab fields -- )
-    [ 2drop ] [ make-fields ] 3bi
-    [ struct-offsets ] keep
-    [ [ type>> ] map compute-struct-align ] keep
-    [ struct-type (define-struct) ] keep
-    [ define-field ] each ; deprecated
-
-: define-union ( name members -- )
-    [ [ heap-size ] [ max ] map-reduce ] keep
-    compute-struct-align f struct-type (define-struct) ; deprecated
-
-: offset-of ( field struct -- offset )
-    c-types get at fields>> 
-    [ name>> = ] with find nip offset>> ;
-
-USE: vocabs.loader
-"specialized-arrays" require

basis/alien/structs/summary.txt

@@ -1 +0,0 @@
-C structure support

basis/alien/syntax/syntax-docs.factor

@@ -1,6 +1,5 @@
 IN: alien.syntax
-USING: alien alien.c-types alien.parser alien.structs
+USING: alien alien.c-types alien.parser classes.struct help.markup help.syntax ;
-classes.struct help.markup help.syntax ;
 
 HELP: DLL"
 { $syntax "DLL\" path\"" }
@@ -54,21 +53,6 @@ HELP: TYPEDEF:
 { $description "Aliases the C type " { $snippet "old" } " under the name " { $snippet "new" } " if ." }
 { $notes "This word differs from " { $link typedef } " in that it runs at parse time, to ensure correct ordering of operations when loading source files. Words defined in source files are compiled before top-level forms are run, so if a source file defines C binding words and uses " { $link typedef } ", the type alias won't be available at compile time." } ;
 
-HELP: C-STRUCT:
-{ $deprecated "New code should use " { $link "classes.struct" } ". See the " { $link POSTPONE: STRUCT: } " word." }
-{ $syntax "C-STRUCT: name pairs... ;" }
-{ $values { "name" "a new C type name" } { "pairs" "C type / field name string pairs" } }
-{ $description "Defines a C struct layout and accessor words." }
-{ $notes "C type names are documented in " { $link "c-types-specs" } "." } ;
-
-HELP: C-UNION:
-{ $deprecated "New code should use " { $link "classes.struct" } ". See the " { $link POSTPONE: UNION-STRUCT: } " word." }
-{ $syntax "C-UNION: name members... ;" }
-{ $values { "name" "a new C type name" } { "members" "a sequence of C types" } }
-{ $description "Defines a new C type sized to fit its largest member." }
-{ $notes "C type names are documented in " { $link "c-types-specs" } "." }
-{ $examples { $code "C-UNION: event \"active-event\" \"keyboard-event\" \"mouse-event\" ;" } } ;
-
 HELP: C-ENUM:
 { $syntax "C-ENUM: words... ;" }
 { $values { "words" "a sequence of word names" } }
@@ -130,8 +114,8 @@ HELP: typedef
 { POSTPONE: TYPEDEF: typedef } related-words
 
 HELP: c-struct?
-{ $values { "type" "a string" } { "?" "a boolean" } }
+{ $values { "c-type" "a C type name" } { "?" "a boolean" } }
-{ $description "Tests if a C type is a structure defined by " { $link POSTPONE: C-STRUCT: } "." } ;
+{ $description "Tests if a C type is a structure defined by " { $link POSTPONE: STRUCT: } "." } ;
 
 HELP: define-function
 { $values { "return" "a C return type" } { "library" "a logical library name" } { "function" "a C function name" } { "parameters" "a sequence of C parameter types" } }

basis/alien/syntax/syntax.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2009 Slava Pestov, Alex Chapman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays alien alien.c-types alien.structs
+USING: accessors arrays alien alien.c-types
 alien.arrays alien.strings kernel math namespaces parser
 sequences words quotations math.parser splitting grouping
 effects assocs combinators lexer strings.parser alien.parser 
@@ -27,12 +27,6 @@ SYNTAX: STDCALL-CALLBACK:
 SYNTAX: TYPEDEF:
     scan-c-type CREATE-C-TYPE typedef ;
 
-SYNTAX: C-STRUCT:
-    scan current-vocab parse-definition define-struct ; deprecated
-
-SYNTAX: C-UNION:
-    scan parse-definition define-union ; deprecated
-
 SYNTAX: C-ENUM:
     ";" parse-tokens
     [ [ create-in ] dip define-constant ] each-index ;

basis/bit-arrays/bit-arrays-docs.factor

@@ -7,7 +7,7 @@ ARTICLE: "bit-arrays" "Bit arrays"
 $nl
 "Bit array words are in the " { $vocab-link "bit-arrays" } " vocabulary."
 $nl
-"Bit arrays play a special role in the C library interface; they can be used to pass binary data back and forth between Factor and C. See " { $link "c-byte-arrays" } "."
+"Bit arrays play a special role in the C library interface; they can be used to pass binary data back and forth between Factor and C. See " { $link "c-pointers" } "."
 $nl
 "Bit arrays form a class of objects:"
 { $subsection bit-array }

basis/classes/struct/struct-docs.factor

@@ -95,9 +95,36 @@ HELP: struct
 HELP: struct-class
 { $class-description "The metaclass of all " { $link struct } " classes." } ;
 
-ARTICLE: "classes.struct" "Struct classes"
+ARTICLE: "classes.struct.examples" "Struct class examples"
-{ $link struct } " classes are similar to " { $link tuple } "s, but their slots exhibit value semantics, and they are backed by a contiguous structured block of memory. Structs can be used for structured access to C memory or Factor byte arrays and for passing struct values in and out of the FFI. Struct types are defined using a syntax similar to tuple syntax:"
+"A struct with a variety of fields:"
+{ $code
+    "USING: alien.c-types classes.struct ;"
+    ""
+    "STRUCT: test-struct"
+    "    { i int }"
+    "    { chicken char[16] }"
+    "    { data void* } ;"
+}
+"Creating a new instance of this struct, and printing out:"
+{ $code "test-struct <struct> ." }
+"Creating a new instance with slots initialized from the stack:"
+{ $code
+    "USING: libc specialized-arrays ;"
+    "SPECIALIZED-ARRAY: char"
+    ""
+    "42"
+    "\"Hello, chicken.\" >char-array"
+    "1024 malloc"
+    "test-struct <struct-boa> ."
+} ;
+
+ARTICLE: "classes.struct.define" "Defining struct classes"
+"Struct classes are defined using a syntax similar to the " { $link POSTPONE: TUPLE: } " syntax for defining tuple classes:"
 { $subsection POSTPONE: STRUCT: }
+"Union structs are also supported, which behave like structs but share the same memory for all the slots."
+{ $subsection POSTPONE: UNION-STRUCT: } ;
+
+ARTICLE: "classes.struct.create" "Creating instances of structs"
 "Structs can be allocated with " { $link new } "- and " { $link boa } "-like constructor words. Additional words are provided for building structs from C memory and from existing buffers:"
 { $subsection <struct> }
 { $subsection <struct-boa> }
@@ -106,10 +133,40 @@ ARTICLE: "classes.struct" "Struct classes"
 "When the contents of a struct will be immediately reset, faster primitive words are available that will create a struct without initializing its contents:"
 { $subsection (struct) }
 { $subsection (malloc-struct) }
-"Structs have literal syntax like tuples:"
+"Structs have literal syntax, similar to " { $link POSTPONE: T{ } " for tuples:"
-{ $subsection POSTPONE: S{ }
+{ $subsection POSTPONE: S{ } ;
-"Union structs are also supported, which behave like structs but share the same memory for all the type's slots."
+
-{ $subsection POSTPONE: UNION-STRUCT: }
+ARTICLE: "classes.struct.c" "Passing structs to C functions"
-;
+"Structs can be passed and returned by value, or by reference."
+$nl
+"If a parameter is declared with a struct type, the parameter is passed by value. To pass a struct by reference, declare a parameter with a pointer to struct type."
+$nl
+"If a C function is declared as returning a struct type, the struct is returned by value, and wrapped in an instance of the correct struct class automatically. If a C function is declared as returning a pointer to a struct, it will return an " { $link alien } " instance. This is because there is no way to distinguish between a pointer to a single struct and a pointer to an array of zero or more structs. It is up to the caller to wrap it in a struct, or a specialized array of structs, respectively."
+$nl
+"An example of a struct declaration:"
+{ $code
+    "USING: alien.c-types classes.struct ;"
+    ""
+    "STRUCT: Point"
+    "    { x int }"
+    "    { y int }"
+    "    { z int } ;"
+}
+"A C function which returns a struct by value:"
+{ $code
+    "USING: alien.syntax ;"
+    "FUNCTION: Point give_me_a_point ( char* description ) ;"
+}
+"A C function which takes a struct parameter by reference:"
+{ $code
+    "FUNCTION: void print_point ( Point* p ) ;"
+} ;
+
+ARTICLE: "classes.struct" "Struct classes"
+{ $link struct } " classes are similar to " { $link tuple } "s, but their slots exhibit value semantics, and they are backed by a contiguous structured block of memory. Structs can be used for structured access to C memory or Factor byte arrays and for passing struct values in and out of the FFI."
+{ $subsection "classes.struct.examples" }
+{ $subsection "classes.struct.define" }
+{ $subsection "classes.struct.create" }
+{ $subsection "classes.struct.c" } ;
 
 ABOUT: "classes.struct"

basis/compiler/codegen/codegen.factor

@@ -4,7 +4,7 @@ USING: namespaces make math math.order math.parser sequences accessors
 kernel kernel.private layouts assocs words summary arrays
 combinators classes.algebra alien alien.c-types
 alien.strings alien.arrays alien.complex alien.libraries sets libc
-continuations.private fry cpu.architecture classes locals
+continuations.private fry cpu.architecture classes classes.struct locals
 source-files.errors slots parser generic.parser
 compiler.errors
 compiler.alien
@@ -16,8 +16,6 @@ compiler.cfg.registers
 compiler.cfg.builder
 compiler.codegen.fixup
 compiler.utilities ;
-QUALIFIED: classes.struct
-QUALIFIED: alien.structs
 IN: compiler.codegen
 
 SYMBOL: insn-counts
@@ -331,10 +329,7 @@ GENERIC: flatten-value-type ( type -- types )
 
 M: object flatten-value-type 1array ;
 
-M: alien.structs:struct-type flatten-value-type ( type -- types )
+M: struct-c-type flatten-value-type ( type -- types )
-    stack-size cell align (flatten-int-type) ;
-
-M: classes.struct:struct-c-type flatten-value-type ( type -- types )
     stack-size cell align (flatten-int-type) ;
 
 M: long-long-type flatten-value-type ( type -- types )

basis/cpu/x86/64/unix/unix.factor

@@ -1,11 +1,9 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays sequences math splitting make assocs kernel
-layouts system alien.c-types cpu.architecture
+layouts system alien.c-types classes.struct cpu.architecture 
 cpu.x86.assembler cpu.x86.assembler.operands cpu.x86 compiler.codegen
 compiler.cfg.registers ;
-QUALIFIED: alien.structs
-QUALIFIED: classes.struct
 IN: cpu.x86.64.unix
 
 M: int-regs param-regs
@@ -48,9 +46,7 @@ stack-params \ (stack-value) c-type (>>rep) >>
         flatten-small-struct
     ] if ;
 
-M: alien.structs:struct-type flatten-value-type ( type -- seq )
+M: struct-c-type flatten-value-type ( type -- seq )
-    flatten-struct ;
-M: classes.struct:struct-c-type flatten-value-type ( type -- seq )
     flatten-struct ;
 
 M: x86.64 return-struct-in-registers? ( c-type -- ? )

basis/help/help-docs.factor

@@ -311,7 +311,7 @@ HELP: textual-list
 { $values { "seq" "a sequence" } { "quot" { $quotation "( elt -- )" } } }
 { $description "Applies the quotation to each element of the sequence, printing a comma between each pair of elements." }
 { $examples
-    { $example "USING: help.markup io ;" "{ \"fish\" \"chips\" \"salt\" } [ write ] textual-list" "fish, chips, salt" }
+    { $example "USING: help.markup io namespaces ;" "last-element off" "{ \"fish\" \"chips\" \"salt\" } [ write ] textual-list" "fish, chips, salt" }
 } ;
 
 HELP: $links

basis/specialized-arrays/specialized-arrays-docs.factor

@@ -21,6 +21,45 @@ ARTICLE: "specialized-array-words" "Specialized array words"
 "Behind the scenes, these words are placed in a vocabulary named " { $snippet "specialized-arrays.instances.T" } ", however this vocabulary should not be placed in a " { $link POSTPONE: USING: } " form directly. Instead, always use " { $link POSTPONE: SPECIALIZED-ARRAY: } ". This ensures that the vocabulary can get generated the first time it is needed." ;
 
 ARTICLE: "specialized-array-c" "Passing specialized arrays to C functions"
+"If a C function is declared as taking a parameter with a pointer or an array type (for example, " { $snippet "float*" } " or " { $snippet "int[3]" } "), instances of the relevant specialized array can be passed in."
+$nl
+"C type specifiers for array types are documented in " { $link "c-types-specs" } "."
+$nl
+"Here is an example; as is common with C functions, the array length is passed in separately, since C does not offer a runtime facility to determine the array length of a base pointer:"
+{ $code
+    "USING: alien.syntax specialized-arrays ;"
+    "SPECIALIZED-ARRAY: int"
+    "FUNCTION: void process_data ( int* data, int len ) ;"
+    "int-array{ 10 20 30 } dup length process_data"
+}
+"Literal specialized arrays, as well as specialized arrays created with " { $snippet "<T-array>" } " and " { $snippet ">T-array" } " are backed by a " { $link byte-array } " in the Factor heap, and can move as a result of garbage collection. If this is unsuitable, the array can be allocated in unmanaged memory instead."
+$nl
+"In the following example, it is presumed that the C library holds on to a pointer to the array's data after the " { $snippet "init_with_data()" } " call returns; this is one situation where unmanaged memory has to be used instead. Note the use of destructors to ensure the memory is deallocated after the block ends:"
+{ $code
+    "USING: alien.syntax specialized-arrays ;"
+    "SPECIALIZED-ARRAY: float"
+    "FUNCTION: void init_with_data ( float* data, int len ) ;"
+    "FUNCTION: float compute_result ( ) ;"
+    "["
+    "    100 malloc-float-array &free"
+    "    dup length init_with_data"
+    "    compute_result"
+    "] with-destructors"
+}
+"Finally, sometimes a C library returns a pointer to an array in unmanaged memory, together with a length. In this case, a specialized array can be constructed to view this memory using " { $snippet "<direct-T-array>" } ":"
+{ $code
+    "USING: alien.c-types classes.struct ;"
+    ""
+    "STRUCT: device_info"
+    "    { id int }"
+    "    { name char* } ;"
+    ""
+    "FUNCTION: void get_device_info ( int* length ) ;"
+    ""
+    "0 <int> [ get_device_info ] keep <direct-int-array> ."
+}
+"For a full discussion of Factor heap allocation versus unmanaged memory allocation, see " { $link "byte-arrays-gc" } "."
+$nl
 "Each specialized array has a " { $slot "underlying" } " slot holding a " { $link byte-array } " with the raw data. Passing a specialized array as a parameter to a C function call will automatically extract the underlying data. To get at the underlying data directly, call the " { $link >c-ptr } " word on a specialized array." ;
 
 ARTICLE: "specialized-array-math" "Vector arithmetic with specialized arrays"
@@ -42,7 +81,7 @@ ARTICLE: "specialized-arrays" "Specialized arrays"
 $nl
 "A specialized array type needs to be generated for each element type. This is done with a parsing word:"
 { $subsection POSTPONE: SPECIALIZED-ARRAY: }
-"This parsing word adds new words to the search path:"
+"This parsing word adds new words to the search path, documented in the next section."
 { $subsection "specialized-array-words" }
 { $subsection "specialized-array-c" }
 { $subsection "specialized-array-math" }

core/alien/alien-docs.factor

@@ -261,7 +261,6 @@ $nl
 "C library interface words are found in the " { $vocab-link "alien" } " vocabulary."
 { $warning "C does not perform runtime type checking, automatic memory management or array bounds checks. Incorrect usage of C library functions can lead to crashes, data corruption, and security exploits." }
 { $subsection "loading-libs" }
-{ $subsection "aliens" }
 { $subsection "alien-invoke" }
 { $subsection "alien-callback" }
 { $subsection "c-data" }

core/byte-arrays/byte-arrays-docs.factor

@@ -6,7 +6,7 @@ ARTICLE: "byte-arrays" "Byte arrays"
 $nl
 "Byte array words are in the " { $vocab-link "byte-arrays" } " vocabulary."
 $nl
-"Byte arrays play a special role in the C library interface; they can be used to pass binary data back and forth between Factor and C. See " { $link "c-byte-arrays" } "."
+"Byte arrays play a special role in the C library interface; they can be used to pass binary data back and forth between Factor and C. See " { $link "c-pointers" } "."
 $nl
 "Byte arrays form a class of objects."
 { $subsection byte-array }

extra/ogg/ogg.factor

@@ -0,0 +1,141 @@
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+!
+USING: 
+    alien
+    alien.c-types 
+    alien.libraries
+    alien.syntax 
+    classes.struct
+    combinators 
+    kernel 
+    system
+;
+IN: ogg
+
+<<
+"ogg" {
+    { [ os winnt? ]  [ "ogg.dll" ] }
+    { [ os macosx? ] [ "libogg.0.dylib" ] }
+    { [ os unix? ]   [ "libogg.so" ] }
+} cond "cdecl" add-library
+>>
+
+LIBRARY: ogg
+
+STRUCT: oggpack-buffer
+    { endbyte long }
+    { endbit int   }
+    { buffer uchar* }
+    { ptr uchar* }
+    { storage long } ;
+
+STRUCT: ogg-page
+    {  header uchar* }
+    {  header_len long }
+    {  body uchar* }
+    {  body_len long } ;
+
+STRUCT: ogg-stream-state
+    {  body_data uchar* }
+    {  body_storage long }
+    {  body_fill long }
+    {  body_returned long }
+    {  lacing_vals int* } 
+    {  granule_vals longlong* }
+    {  lacing_storage long }
+    {  lacing_fill long }
+    {  lacing_packet long }
+    {  lacing_returned long }
+    {  header { uchar 282 } }
+    {  header_fill int }
+    {  e_o_s int }
+    {  b_o_s int }
+    {  serialno long  }
+    {  pageno long }
+    {  packetno longlong }
+    {  granulepos longlong } ;
+
+STRUCT: ogg-packet
+    {  packet uchar* }
+    {  bytes long }
+    {  b_o_s long }
+    {  e_o_s long }
+    {  granulepos longlong }
+    {  packetno longlong } ;
+
+STRUCT: ogg-sync-state
+    { data uchar* }
+    { storage int }
+    { fill int }  
+    { returned int }
+    { unsynced int }
+    { headerbytes int }
+    { bodybytes int } ;
+
+FUNCTION: void oggpack_writeinit ( oggpack-buffer* b ) ;
+FUNCTION: void  oggpack_writetrunc ( oggpack-buffer* b, long bits ) ;
+FUNCTION: void  oggpack_writealign ( oggpack-buffer* b) ;
+FUNCTION: void  oggpack_writecopy ( oggpack-buffer* b, void* source, long bits ) ;
+FUNCTION: void  oggpack_reset ( oggpack-buffer* b ) ;
+FUNCTION: void  oggpack_writeclear ( oggpack-buffer* b ) ;
+FUNCTION: void  oggpack_readinit ( oggpack-buffer* b, uchar* buf, int bytes ) ;
+FUNCTION: void  oggpack_write ( oggpack-buffer* b, ulong value, int bits ) ;
+FUNCTION: long  oggpack_look ( oggpack-buffer* b, int bits ) ;
+FUNCTION: long  oggpack_look1 ( oggpack-buffer* b ) ;
+FUNCTION: void  oggpack_adv ( oggpack-buffer* b, int bits ) ;
+FUNCTION: void  oggpack_adv1 ( oggpack-buffer* b ) ;
+FUNCTION: long  oggpack_read ( oggpack-buffer* b, int bits ) ;
+FUNCTION: long  oggpack_read1 ( oggpack-buffer* b ) ;
+FUNCTION: long  oggpack_bytes ( oggpack-buffer* b ) ;
+FUNCTION: long  oggpack_bits ( oggpack-buffer* b ) ;
+FUNCTION: uchar* oggpack_get_buffer ( oggpack-buffer* b ) ;
+FUNCTION: void  oggpackB_writeinit ( oggpack-buffer* b ) ;
+FUNCTION: void  oggpackB_writetrunc ( oggpack-buffer* b, long bits ) ;
+FUNCTION: void  oggpackB_writealign ( oggpack-buffer* b ) ;
+FUNCTION: void  oggpackB_writecopy ( oggpack-buffer* b, void* source, long bits ) ;
+FUNCTION: void  oggpackB_reset ( oggpack-buffer* b ) ;
+FUNCTION: void  oggpackB_writeclear ( oggpack-buffer* b ) ;
+FUNCTION: void  oggpackB_readinit ( oggpack-buffer* b, uchar* buf, int bytes ) ;
+FUNCTION: void  oggpackB_write ( oggpack-buffer* b, ulong value, int bits ) ;
+FUNCTION: long  oggpackB_look ( oggpack-buffer* b, int bits ) ;
+FUNCTION: long  oggpackB_look1 ( oggpack-buffer* b ) ;
+FUNCTION: void  oggpackB_adv ( oggpack-buffer* b, int bits ) ;
+FUNCTION: void  oggpackB_adv1 ( oggpack-buffer* b ) ;
+FUNCTION: long  oggpackB_read ( oggpack-buffer* b, int bits ) ;
+FUNCTION: long  oggpackB_read1 ( oggpack-buffer* b ) ;
+FUNCTION: long  oggpackB_bytes ( oggpack-buffer* b ) ;
+FUNCTION: long  oggpackB_bits ( oggpack-buffer* b ) ;
+FUNCTION: uchar* oggpackB_get_buffer ( oggpack-buffer* b ) ;
+FUNCTION: int      ogg_stream_packetin ( ogg-stream-state* os, ogg-packet* op ) ;
+FUNCTION: int      ogg_stream_pageout ( ogg-stream-state* os, ogg-page* og ) ;
+FUNCTION: int      ogg_stream_flush ( ogg-stream-state* os, ogg-page* og ) ;
+FUNCTION: int      ogg_sync_init ( ogg-sync-state* oy ) ;
+FUNCTION: int      ogg_sync_clear ( ogg-sync-state* oy ) ;
+FUNCTION: int      ogg_sync_reset ( ogg-sync-state* oy ) ;
+FUNCTION: int   ogg_sync_destroy ( ogg-sync-state* oy ) ;
+
+FUNCTION: void* ogg_sync_buffer ( ogg-sync-state* oy, long size ) ;
+FUNCTION: int      ogg_sync_wrote ( ogg-sync-state* oy, long bytes ) ;
+FUNCTION: long     ogg_sync_pageseek ( ogg-sync-state* oy, ogg-page* og ) ;
+FUNCTION: int      ogg_sync_pageout ( ogg-sync-state* oy, ogg-page* og ) ;
+FUNCTION: int      ogg_stream_pagein ( ogg-stream-state* os, ogg-page* og ) ;
+FUNCTION: int      ogg_stream_packetout ( ogg-stream-state* os, ogg-packet* op ) ;
+FUNCTION: int      ogg_stream_packetpeek ( ogg-stream-state* os, ogg-packet* op ) ;
+FUNCTION: int      ogg_stream_init (ogg-stream-state* os, int serialno ) ;
+FUNCTION: int      ogg_stream_clear ( ogg-stream-state* os ) ;
+FUNCTION: int      ogg_stream_reset ( ogg-stream-state* os ) ;
+FUNCTION: int      ogg_stream_reset_serialno ( ogg-stream-state* os, int serialno ) ;
+FUNCTION: int      ogg_stream_destroy ( ogg-stream-state* os ) ;
+FUNCTION: int      ogg_stream_eos ( ogg-stream-state* os ) ;
+FUNCTION: void     ogg_page_checksum_set ( ogg-page* og ) ;
+FUNCTION: int      ogg_page_version ( ogg-page* og ) ;
+FUNCTION: int      ogg_page_continued ( ogg-page* og ) ;
+FUNCTION: int      ogg_page_bos ( ogg-page* og ) ;
+FUNCTION: int      ogg_page_eos ( ogg-page* og ) ;
+FUNCTION: longlong  ogg_page_granulepos ( ogg-page* og ) ;
+FUNCTION: int      ogg_page_serialno ( ogg-page* og ) ;
+FUNCTION: long     ogg_page_pageno ( ogg-page* og ) ;
+FUNCTION: int      ogg_page_packets ( ogg-page* og ) ;
+FUNCTION: void     ogg_packet_clear ( ogg-packet* op ) ;
+

extra/ogg/theora/theora.factor

@@ -0,0 +1,181 @@
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+!
+USING: 
+    alien
+    alien.c-types 
+    alien.libraries
+    alien.syntax 
+    classes.struct
+    combinators 
+    kernel 
+    ogg
+    system
+;
+IN: ogg.theora
+
+<<
+"theoradec" {
+    { [ os winnt? ]  [ "theoradec.dll" ] }
+    { [ os macosx? ] [ "libtheoradec.0.dylib" ] }
+    { [ os unix? ]   [ "libtheoradec.so" ] }
+} cond "cdecl" add-library
+
+"theoraenc" {
+    { [ os winnt? ]  [ "theoraenc.dll" ] }
+    { [ os macosx? ] [ "libtheoraenc.0.dylib" ] }
+    { [ os unix? ]   [ "libtheoraenc.so" ] }
+} cond "cdecl" add-library
+>>
+
+CONSTANT: TH-EFAULT      -1
+CONSTANT: TH-EINVAL     -10
+CONSTANT: TH-EBADHEADER -20
+CONSTANT: TH-ENOTFORMAT -21
+CONSTANT: TH-EVERSION   -22
+CONSTANT: TH-EIMPL      -23
+CONSTANT: TH-EBADPACKET -24
+CONSTANT: TH-DUPFRAME     1
+
+TYPEDEF: int th-colorspace 
+CONSTANT: TH-CS-UNSPECIFIED   0
+CONSTANT: TH-CS-ITU-REC-470M  1
+CONSTANT: TH-CS-ITU-REC-470BG 2
+CONSTANT: TH-CS-NSPACES       3
+
+TYPEDEF: int th-pixelformat
+CONSTANT: TH-PF-RSVD     0
+CONSTANT: TH-PF-422      1
+CONSTANT: TH-PF-444      2
+CONSTANT: TH-PF-NFORMATS 3
+
+STRUCT: th-img-plane
+    { width int }
+    { height int }
+    { stride int }
+    { data uchar* }
+;
+
+TYPEDEF: th-img-plane[3] th-ycbcr-buffer
+
+STRUCT: th-info
+    { version-major uchar }
+    { version-minor uchar }
+    { version-subminor uchar }
+    { frame-width uint }
+    { frame-height uint }
+    { pic-width uint }
+    { pic-height uint }
+    { pic-x uint }
+    { pic-y uint }
+    { fps-numerator uint }
+    { fps-denominator uint }
+    { aspect-numerator uint }
+    { aspect-denominator uint }
+    { colorspace th-colorspace }
+    { pixel-fmt th-pixelformat }
+    { target-bitrate int }
+    { quality int }
+    { keyframe-granule-shift int }
+;
+
+STRUCT: th-comment
+    { user-comments char** }
+    { comment-lengths int* }
+    { comments int }
+    { vendor char* }
+;
+
+TYPEDEF: uchar[64] th-quant-base
+
+STRUCT: th-quant-ranges
+    { nranges int }
+    { sizes int* }
+    { base-matrices th-quant-base* }
+;
+
+STRUCT: th-quant-info
+    { dc-scale { short 64 } }
+    { ac-scale { short 64 } }
+    { loop-filter-limits { uchar 64 } }
+    { qi-ranges { th-quant-ranges 2 3 } }
+;
+
+CONSTANT: TH-NHUFFMANE-TABLES 80
+CONSTANT: TH-NDCT-TOKENS 32
+
+STRUCT: th-huff-code
+    { pattern int }
+    { nbits int }
+;
+
+LIBRARY: theoradec
+FUNCTION: char* th_version_string ( ) ;
+FUNCTION: uint th_version_number ( ) ;
+FUNCTION: longlong th_granule_frame ( void* encdec, longlong granpos) ;
+FUNCTION: int th_packet_isheader ( ogg-packet* op ) ;
+FUNCTION: int th_packet_iskeyframe ( ogg-packet* op ) ;
+FUNCTION: void th_info_init ( th-info* info ) ;
+FUNCTION: void th_info_clear ( th-info* info ) ;
+FUNCTION: void th_comment_init ( th-comment* tc ) ;
+FUNCTION: void th_comment_add ( th-comment* tc, char* comment ) ;
+FUNCTION: void th_comment_add_tag ( th-comment* tc, char* tag, char* value ) ;
+FUNCTION: char* th_comment_query ( th-comment* tc, char* tag, int count ) ;
+FUNCTION: int   th_comment_query_count ( th-comment* tc, char* tag ) ;
+FUNCTION: void  th_comment_clear ( th-comment* tc ) ;
+
+CONSTANT: TH-ENCCTL-SET-HUFFMAN-CODES 0
+CONSTANT: TH-ENCCTL-SET-QUANT-PARAMS 2
+CONSTANT: TH-ENCCTL-SET-KEYFRAME-FREQUENCY-FORCE 4
+CONSTANT: TH-ENCCTL-SET-VP3-COMPATIBLE 10
+CONSTANT: TH-ENCCTL-GET-SPLEVEL-MAX 12
+CONSTANT: TH-ENCCTL-SET-SPLEVEL 14
+CONSTANT: TH-ENCCTL-SET-DUP-COUNT 18
+CONSTANT: TH-ENCCTL-SET-RATE-FLAGS 20
+CONSTANT: TH-ENCCTL-SET-RATE-BUFFER 22
+CONSTANT: TH-ENCCTL-2PASS-OUT 24
+CONSTANT: TH-ENCCTL-2PASS-IN 26
+CONSTANT: TH-ENCCTL-SET-QUALITY 28
+CONSTANT: TH-ENCCTL-SET-BITRATE 30
+
+CONSTANT: TH-RATECTL-DROP-FRAMES 1
+CONSTANT: TH-RATECTL-CAP-OVERFLOW 2
+CONSTANT: TH-RATECTL-CAP-UNDERFOW 4
+
+TYPEDEF: void* th-enc-ctx
+
+LIBRARY: theoraenc
+FUNCTION: th-enc-ctx* th_encode_alloc ( th-info* info ) ;
+FUNCTION: int th_encode_ctl ( th-enc-ctx* enc, int req, void* buf, int buf_sz ) ;
+FUNCTION: int th_encode_flushheader ( th-enc-ctx* enc, th-comment* comments, ogg-packet* op ) ;
+FUNCTION: int th_encode_ycbcr_in ( th-enc-ctx* enc, th-ycbcr-buffer ycbcr ) ;
+FUNCTION: int th_encode_packetout ( th-enc-ctx* enc, int last, ogg-packet* op ) ;
+FUNCTION: void th_encode_free ( th-enc-ctx* enc ) ;
+
+CONSTANT: TH-DECCTL-GET-PPLEVEL-MAX 1
+CONSTANT: TH-DECCTL-SET-PPLEVEL 3
+CONSTANT: TH-DECCTL-SET-GRANPOS 5
+CONSTANT: TH-DECCTL-SET-STRIPE-CB 7
+CONSTANT: TH-DECCTL-SET-TELEMETRY-MBMODE 9
+CONSTANT: TH-DECCTL-SET-TELEMETRY-MV 11
+CONSTANT: TH-DECCTL-SET-TELEMETRY-QI 13
+CONSTANT: TH-DECCTL-SET-TELEMETRY-BITS 15
+
+TYPEDEF: void* th-stripe-decoded-func
+
+STRUCT: th-stripe-callback
+    { ctx void* }
+    { stripe-decoded th-stripe-decoded-func }
+;
+
+TYPEDEF: void* th-dec-ctx
+TYPEDEF: void* th-setup-info
+
+LIBRARY: theoradec
+FUNCTION: int th_decode_headerin ( th-info* info, th-comment* tc, th-setup-info** setup, ogg-packet* op ) ;
+FUNCTION: th-dec-ctx* th_decode_alloc ( th-info* info, th-setup-info* setup ) ;
+FUNCTION: void th_setup_free ( th-setup-info* setup ) ;
+FUNCTION: int th_decode_ctl ( th-dec-ctx* dec, int req, void* buf, int buf_sz ) ;
+FUNCTION: int th_decode_packetin ( th-dec-ctx* dec, ogg-packet* op, longlong granpos ) ;
+FUNCTION: int th_decode_ycbcr_out ( th-dec-ctx* dec, th-ycbcr-buffer ycbcr ) ;
+FUNCTION: void th_decode_free ( th-dec-ctx* dec ) ;

extra/ogg/vorbis/vorbis.factor

@@ -0,0 +1,151 @@
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+!
+USING: 
+    alien
+    alien.c-types 
+    alien.libraries
+    alien.syntax 
+    classes.struct
+    combinators 
+    kernel 
+    ogg
+    system
+;
+IN: ogg.vorbis
+
+<<
+"vorbis" {
+    { [ os winnt? ]  [ "vorbis.dll" ] }
+    { [ os macosx? ] [ "libvorbis.0.dylib" ] }
+    { [ os unix? ]   [ "libvorbis.so" ] }
+} cond "cdecl" add-library 
+>>
+
+LIBRARY: vorbis
+
+STRUCT: vorbis-info 
+    { version int  }
+    { channels int }
+    { rate long }
+    { bitrate_upper long }
+    { bitrate_nominal long }
+    { bitrate_lower long }
+    { bitrate_window long }
+    { codec_setup void* } 
+    ;
+
+STRUCT: vorbis-dsp-state
+    { analysisp int }
+    { vi vorbis-info* }
+    { pcm float** }
+    { pcmret float** }
+    { pcm_storage int }
+    { pcm_current int }
+    { pcm_returned int }
+    { preextrapolate int }
+    { eofflag int }
+    { lW long }
+    { W long }
+    { nW long }
+    { centerW long }
+    { granulepos longlong }
+    { sequence longlong }
+    { glue_bits longlong }
+    { time_bits longlong }
+    { floor_bits longlong }
+    { res_bits longlong }
+    { backend_state void* }
+    ;
+
+STRUCT: alloc-chain
+    { ptr void* }
+    { next void* }
+    ;
+
+STRUCT: vorbis-block
+    { pcm float** }
+    { opb oggpack-buffer }
+    { lW long }
+    { W long }
+    { nW long }
+    { pcmend int }
+    { mode int }
+    { eofflag int }
+    { granulepos longlong }
+    { sequence longlong }
+    { vd vorbis-dsp-state* }
+    { localstore void* }
+    { localtop long }
+    { localalloc long }
+    { totaluse long }
+    { reap alloc-chain* }
+    { glue_bits long }
+    { time_bits long }
+    { floor_bits long }
+    { res_bits long }
+    { internal void* }
+    ;
+
+STRUCT: vorbis-comment
+    { usercomments char** }
+    { comment_lengths int* }
+    { comments int }
+    { vendor char* }
+    ;
+
+FUNCTION: void     vorbis_info_init ( vorbis-info* vi ) ;
+FUNCTION: void     vorbis_info_clear ( vorbis-info* vi ) ;
+FUNCTION: int      vorbis_info_blocksize ( vorbis-info* vi, int zo ) ;
+FUNCTION: void     vorbis_comment_init ( vorbis-comment* vc ) ;
+FUNCTION: void     vorbis_comment_add ( vorbis-comment* vc, char* comment ) ;
+FUNCTION: void     vorbis_comment_add_tag ( vorbis-comment* vc, char* tag, char* contents ) ;
+FUNCTION: char*    vorbis_comment_query ( vorbis-comment* vc, char* tag, int count ) ;
+FUNCTION: int      vorbis_comment_query_count ( vorbis-comment* vc, char* tag ) ;
+FUNCTION: void     vorbis_comment_clear ( vorbis-comment* vc ) ;
+FUNCTION: int      vorbis_block_init ( vorbis-dsp-state* v, vorbis-block* vb ) ;
+FUNCTION: int      vorbis_block_clear ( vorbis-block* vb ) ;
+FUNCTION: void     vorbis_dsp_clear ( vorbis-dsp-state* v ) ;
+FUNCTION: double   vorbis_granule_time ( vorbis-dsp-state* v, longlong granulepos ) ;
+FUNCTION: int      vorbis_analysis_init ( vorbis-dsp-state* v, vorbis-info* vi ) ;
+FUNCTION: int      vorbis_commentheader_out ( vorbis-comment* vc, ogg-packet* op ) ;
+FUNCTION: int      vorbis_analysis_headerout ( vorbis-dsp-state* v,
+                                          vorbis-comment* vc,
+                                          ogg-packet* op,
+                                          ogg-packet* op_comm,
+                                          ogg-packet* op_code ) ;
+FUNCTION: float**  vorbis_analysis_buffer ( vorbis-dsp-state* v, int vals ) ;
+FUNCTION: int      vorbis_analysis_wrote ( vorbis-dsp-state* v, int vals ) ;
+FUNCTION: int      vorbis_analysis_blockout ( vorbis-dsp-state* v, vorbis-block* vb ) ;
+FUNCTION: int      vorbis_analysis ( vorbis-block* vb, ogg-packet* op ) ;
+FUNCTION: int      vorbis_bitrate_addblock ( vorbis-block* vb ) ;
+FUNCTION: int      vorbis_bitrate_flushpacket ( vorbis-dsp-state* vd,
+                                           ogg-packet* op ) ;
+FUNCTION: int      vorbis_synthesis_headerin ( vorbis-info* vi, vorbis-comment* vc,
+                                          ogg-packet* op ) ;
+FUNCTION: int      vorbis_synthesis_init ( vorbis-dsp-state* v, vorbis-info* vi ) ;
+FUNCTION: int      vorbis_synthesis_restart ( vorbis-dsp-state* v ) ;
+FUNCTION: int      vorbis_synthesis ( vorbis-block* vb, ogg-packet* op ) ;
+FUNCTION: int      vorbis_synthesis_trackonly ( vorbis-block* vb, ogg-packet* op ) ;
+FUNCTION: int      vorbis_synthesis_blockin ( vorbis-dsp-state* v, vorbis-block* vb ) ;
+FUNCTION: int      vorbis_synthesis_pcmout ( vorbis-dsp-state* v, float*** pcm ) ;
+FUNCTION: int      vorbis_synthesis_lapout ( vorbis-dsp-state* v, float*** pcm ) ;
+FUNCTION: int      vorbis_synthesis_read ( vorbis-dsp-state* v, int samples ) ;
+FUNCTION: long     vorbis_packet_blocksize ( vorbis-info* vi, ogg-packet* op ) ;
+FUNCTION: int      vorbis_synthesis_halfrate ( vorbis-info* v, int flag ) ;
+FUNCTION: int      vorbis_synthesis_halfrate_p ( vorbis-info* v ) ;
+
+CONSTANT: OV_FALSE -1
+CONSTANT: OV_EOF -2
+CONSTANT: OV_HOLE -3
+CONSTANT: OV_EREAD -128
+CONSTANT: OV_EFAULT -129
+CONSTANT: OV_EIMPL -130
+CONSTANT: OV_EINVAL -131
+CONSTANT: OV_ENOTVORBIS -132
+CONSTANT: OV_EBADHEADER -133
+CONSTANT: OV_EVERSION -134
+CONSTANT: OV_ENOTAUDIO -135
+CONSTANT: OV_EBADPACKET -136
+CONSTANT: OV_EBADLINK -137
+CONSTANT: OV_ENOSEEK -138

unmaintained/ogg/ogg.factor

@@ -1,132 +0,0 @@
-! Copyright (C) 2007 Chris Double.
-! See http://factorcode.org/license.txt for BSD license.
-!
-USING: kernel system combinators alien alien.syntax ;
-IN: ogg
-
-<<
-"ogg" {
-    { [ os winnt? ]  [ "ogg.dll" ] }
-    { [ os macosx? ] [ "libogg.0.dylib" ] }
-    { [ os unix? ]   [ "libogg.so" ] }
-} cond "cdecl" add-library
->>
-
-LIBRARY: ogg
-
-C-STRUCT: oggpack_buffer
-    { "long" "endbyte" }
-    { "int" "endbit" }
-    { "uchar*" "buffer" }
-    { "uchar*" "ptr" }
-    { "long" "storage" } ;
-
-C-STRUCT: ogg_page
-    { "uchar*" "header" }
-    { "long" "header_len" }
-    { "uchar*" "body" }
-    { "long" "body_len" } ;
-
-C-STRUCT: ogg_stream_state
-    { "uchar*" "body_data" }
-    { "long" "body_storage" }
-    { "long" "body_fill" }
-    { "long" "body_returned" }
-    { "int*" "lacing_vals" } 
-    { "longlong*" "granule_vals" }
-    { "long" "lacing_storage" }
-    { "long" "lacing_fill" }
-    { "long" "lacing_packet" }
-    { "long" "lacing_returned" }
-    { { "uchar" 282 } "header" }
-    { "int" "header_fill" }
-    { "int" "e_o_s" }
-    { "int" "b_o_s" }
-    { "long" "serialno" }
-    { "long" "pageno" }
-    { "longlong" "packetno" }
-    { "longlong" "granulepos" } ;
-
-C-STRUCT: ogg_packet
-    { "uchar*" "packet" }
-    { "long" "bytes" }
-    { "long" "b_o_s" }
-    { "long" "e_o_s" }
-    { "longlong" "granulepos" }
-    { "longlong" "packetno" } ;
-
-C-STRUCT: ogg_sync_state
-    { "uchar*" "data" }
-    { "int" "storage" }
-    { "int" "fill" }  
-    { "int" "returned" }
-    { "int" "unsynced" }
-    { "int" "headerbytes" }
-    { "int" "bodybytes" } ;
-
-FUNCTION: void oggpack_writeinit ( oggpack_buffer* b ) ;
-FUNCTION: void  oggpack_writetrunc ( oggpack_buffer* b, long bits ) ;
-FUNCTION: void  oggpack_writealign ( oggpack_buffer* b) ;
-FUNCTION: void  oggpack_writecopy ( oggpack_buffer* b, void* source, long bits ) ;
-FUNCTION: void  oggpack_reset ( oggpack_buffer* b ) ;
-FUNCTION: void  oggpack_writeclear ( oggpack_buffer* b ) ;
-FUNCTION: void  oggpack_readinit ( oggpack_buffer* b, uchar* buf, int bytes ) ;
-FUNCTION: void  oggpack_write ( oggpack_buffer* b, ulong value, int bits ) ;
-FUNCTION: long  oggpack_look ( oggpack_buffer* b, int bits ) ;
-FUNCTION: long  oggpack_look1 ( oggpack_buffer* b ) ;
-FUNCTION: void  oggpack_adv ( oggpack_buffer* b, int bits ) ;
-FUNCTION: void  oggpack_adv1 ( oggpack_buffer* b ) ;
-FUNCTION: long  oggpack_read ( oggpack_buffer* b, int bits ) ;
-FUNCTION: long  oggpack_read1 ( oggpack_buffer* b ) ;
-FUNCTION: long  oggpack_bytes ( oggpack_buffer* b ) ;
-FUNCTION: long  oggpack_bits ( oggpack_buffer* b ) ;
-FUNCTION: uchar* oggpack_get_buffer ( oggpack_buffer* b ) ;
-FUNCTION: void  oggpackB_writeinit ( oggpack_buffer* b ) ;
-FUNCTION: void  oggpackB_writetrunc ( oggpack_buffer* b, long bits ) ;
-FUNCTION: void  oggpackB_writealign ( oggpack_buffer* b ) ;
-FUNCTION: void  oggpackB_writecopy ( oggpack_buffer* b, void* source, long bits ) ;
-FUNCTION: void  oggpackB_reset ( oggpack_buffer* b ) ;
-FUNCTION: void  oggpackB_writeclear ( oggpack_buffer* b ) ;
-FUNCTION: void  oggpackB_readinit ( oggpack_buffer* b, uchar* buf, int bytes ) ;
-FUNCTION: void  oggpackB_write ( oggpack_buffer* b, ulong value, int bits ) ;
-FUNCTION: long  oggpackB_look ( oggpack_buffer* b, int bits ) ;
-FUNCTION: long  oggpackB_look1 ( oggpack_buffer* b ) ;
-FUNCTION: void  oggpackB_adv ( oggpack_buffer* b, int bits ) ;
-FUNCTION: void  oggpackB_adv1 ( oggpack_buffer* b ) ;
-FUNCTION: long  oggpackB_read ( oggpack_buffer* b, int bits ) ;
-FUNCTION: long  oggpackB_read1 ( oggpack_buffer* b ) ;
-FUNCTION: long  oggpackB_bytes ( oggpack_buffer* b ) ;
-FUNCTION: long  oggpackB_bits ( oggpack_buffer* b ) ;
-FUNCTION: uchar* oggpackB_get_buffer ( oggpack_buffer* b ) ;
-FUNCTION: int      ogg_stream_packetin ( ogg_stream_state* os, ogg_packet* op ) ;
-FUNCTION: int      ogg_stream_pageout ( ogg_stream_state* os, ogg_page* og ) ;
-FUNCTION: int      ogg_stream_flush ( ogg_stream_state* os, ogg_page* og ) ;
-FUNCTION: int      ogg_sync_init ( ogg_sync_state* oy ) ;
-FUNCTION: int      ogg_sync_clear ( ogg_sync_state* oy ) ;
-FUNCTION: int      ogg_sync_reset ( ogg_sync_state* oy ) ;
-FUNCTION: int   ogg_sync_destroy ( ogg_sync_state* oy ) ;
-
-FUNCTION: void* ogg_sync_buffer ( ogg_sync_state* oy, long size ) ;
-FUNCTION: int      ogg_sync_wrote ( ogg_sync_state* oy, long bytes ) ;
-FUNCTION: long     ogg_sync_pageseek ( ogg_sync_state* oy, ogg_page* og ) ;
-FUNCTION: int      ogg_sync_pageout ( ogg_sync_state* oy, ogg_page* og ) ;
-FUNCTION: int      ogg_stream_pagein ( ogg_stream_state* os, ogg_page* og ) ;
-FUNCTION: int      ogg_stream_packetout ( ogg_stream_state* os, ogg_packet* op ) ;
-FUNCTION: int      ogg_stream_packetpeek ( ogg_stream_state* os, ogg_packet* op ) ;
-FUNCTION: int      ogg_stream_init (ogg_stream_state* os, int serialno ) ;
-FUNCTION: int      ogg_stream_clear ( ogg_stream_state* os ) ;
-FUNCTION: int      ogg_stream_reset ( ogg_stream_state* os ) ;
-FUNCTION: int      ogg_stream_reset_serialno ( ogg_stream_state* os, int serialno ) ;
-FUNCTION: int      ogg_stream_destroy ( ogg_stream_state* os ) ;
-FUNCTION: int      ogg_stream_eos ( ogg_stream_state* os ) ;
-FUNCTION: void     ogg_page_checksum_set ( ogg_page* og ) ;
-FUNCTION: int      ogg_page_version ( ogg_page* og ) ;
-FUNCTION: int      ogg_page_continued ( ogg_page* og ) ;
-FUNCTION: int      ogg_page_bos ( ogg_page* og ) ;
-FUNCTION: int      ogg_page_eos ( ogg_page* og ) ;
-FUNCTION: longlong  ogg_page_granulepos ( ogg_page* og ) ;
-FUNCTION: int      ogg_page_serialno ( ogg_page* og ) ;
-FUNCTION: long     ogg_page_pageno ( ogg_page* og ) ;
-FUNCTION: int      ogg_page_packets ( ogg_page* og ) ;
-FUNCTION: void     ogg_packet_clear ( ogg_packet* op ) ;
-

unmaintained/ogg/theora/theora.factor

@@ -1,120 +0,0 @@
-! Copyright (C) 2007 Chris Double.
-! See http://factorcode.org/license.txt for BSD license.
-!
-USING: kernel system combinators alien alien.syntax ;
-IN: ogg.theora
-
-<<
-"theora" {
-    { [ os winnt? ]  [ "theora.dll" ] }
-    { [ os macosx? ] [ "libtheora.0.dylib" ] }
-    { [ os unix? ]   [ "libtheora.so" ] }
-} cond "cdecl" add-library
->>
-
-LIBRARY: theora
-
-C-STRUCT: yuv_buffer
-    { "int" "y_width" }
-    { "int" "y_height" }
-    { "int" "y_stride" }
-    { "int" "uv_width" }
-    { "int" "uv_height" }
-    { "int" "uv_stride" }
-    { "void*" "y" }
-    { "void*" "u" }
-    { "void*" "v" } ;
-
-: OC_CS_UNSPECIFIED ( -- number ) 0 ; inline
-: OC_CS_ITU_REC_470M ( -- number ) 1 ; inline
-: OC_CS_ITU_REC_470BG ( -- number ) 2 ; inline
-: OC_CS_NSPACES ( -- number ) 3 ; inline
-
-TYPEDEF: int theora_colorspace 
-
-: OC_PF_420 ( -- number ) 0 ; inline
-: OC_PF_RSVD ( -- number ) 1 ; inline
-: OC_PF_422 ( -- number ) 2 ; inline
-: OC_PF_444 ( -- number ) 3 ; inline
-
-TYPEDEF: int theora_pixelformat
-
-C-STRUCT: theora_info
-    { "uint" "width" }
-    { "uint" "height" }
-    { "uint" "frame_width" }
-    { "uint" "frame_height" }
-    { "uint" "offset_x" }
-    { "uint" "offset_y" }
-    { "uint" "fps_numerator" }
-    { "uint" "fps_denominator" }
-    { "uint" "aspect_numerator" }
-    { "uint" "aspect_denominator" }
-    { "theora_colorspace" "colorspace" }
-    { "int" "target_bitrate" }
-    { "int" "quality" }
-    { "int" "quick_p" }
-    { "uchar" "version_major" }
-    { "uchar" "version_minor" } 
-    { "uchar" "version_subminor" }
-    { "void*" "codec_setup" }
-    { "int" "dropframes_p" }
-    { "int" "keyframe_auto_p" }
-    { "uint" "keyframe_frequency" }
-    { "uint" "keyframe_frequency_force" }
-    { "uint" "keyframe_data_target_bitrate" }
-    { "int" "keyframe_auto_threshold" }
-    { "uint" "keyframe_mindistance" }
-    { "int" "noise_sensitivity" }
-    { "int" "sharpness" }
-    { "theora_pixelformat" "pixelformat" } ;
-
-C-STRUCT: theora_state
-    { "theora_info*" "i" }
-    { "longlong" "granulepos" }
-    { "void*" "internal_encode" }
-    { "void*" "internal_decode" } ;
-
-C-STRUCT: theora_comment
-    { "char**" "user_comments" }
-    { "int*" "comment_lengths" }
-    { "int" "comments" }
-    { "char*" "vendor" } ;
-
-: OC_FAULT ( -- number ) -1 ; inline
-: OC_EINVAL ( -- number ) -10 ; inline
-: OC_DISABLED ( -- number ) -11 ; inline
-: OC_BADHEADER ( -- number ) -20 ; inline
-: OC_NOTFORMAT ( -- number ) -21 ; inline
-: OC_VERSION ( -- number ) -22 ; inline
-: OC_IMPL ( -- number ) -23 ; inline
-: OC_BADPACKET ( -- number ) -24 ; inline
-: OC_NEWPACKET ( -- number ) -25 ; inline
-: OC_DUPFRAME ( -- number ) 1 ; inline
-
-FUNCTION: char* theora_version_string ( ) ;
-FUNCTION: uint theora_version_number ( ) ;
-FUNCTION: int theora_encode_init ( theora_state* th, theora_info* ti ) ;
-FUNCTION: int theora_encode_YUVin ( theora_state* t, yuv_buffer* yuv ) ;
-FUNCTION: int theora_encode_packetout ( theora_state* t, int last_p, ogg_packet* op ) ;
-FUNCTION: int theora_encode_header ( theora_state* t, ogg_packet* op ) ;
-FUNCTION: int theora_encode_comment ( theora_comment* tc, ogg_packet* op ) ;
-FUNCTION: int theora_encode_tables ( theora_state* t, ogg_packet* op ) ;
-FUNCTION: int theora_decode_header ( theora_info* ci, theora_comment* cc, ogg_packet* op ) ;
-FUNCTION: int theora_decode_init ( theora_state* th, theora_info* c ) ;
-FUNCTION: int theora_decode_packetin ( theora_state* th, ogg_packet* op ) ;
-FUNCTION: int theora_decode_YUVout ( theora_state* th, yuv_buffer* yuv ) ;
-FUNCTION: int theora_packet_isheader ( ogg_packet* op ) ;
-FUNCTION: int theora_packet_iskeyframe ( ogg_packet* op ) ;
-FUNCTION: int theora_granule_shift ( theora_info* ti ) ;
-FUNCTION: longlong theora_granule_frame ( theora_state* th, longlong granulepos ) ;
-FUNCTION: double theora_granule_time ( theora_state* th, longlong granulepos ) ;
-FUNCTION: void theora_info_init ( theora_info* c ) ;
-FUNCTION: void theora_info_clear ( theora_info* c ) ;
-FUNCTION: void theora_clear ( theora_state* t ) ;
-FUNCTION: void theora_comment_init ( theora_comment* tc ) ;
-FUNCTION: void theora_comment_add ( theora_comment* tc, char* comment ) ;
-FUNCTION: void theora_comment_add_tag ( theora_comment* tc, char* tag, char* value ) ;
-FUNCTION: char* theora_comment_query ( theora_comment* tc, char* tag, int count ) ;
-FUNCTION: int   theora_comment_query_count ( theora_comment* tc, char* tag ) ;
-FUNCTION: void  theora_comment_clear ( theora_comment* tc ) ;

unmaintained/ogg/vorbis/vorbis.factor

@@ -1,141 +0,0 @@
-! Copyright (C) 2007 Chris Double.
-! See http://factorcode.org/license.txt for BSD license.
-!
-USING: kernel system combinators alien alien.syntax ogg ;
-IN: ogg.vorbis
-
-<<
-"vorbis" {
-    { [ os winnt? ]  [ "vorbis.dll" ] }
-    { [ os macosx? ] [ "libvorbis.0.dylib" ] }
-    { [ os unix? ]   [ "libvorbis.so" ] }
-} cond "cdecl" add-library 
->>
-
-LIBRARY: vorbis
-
-C-STRUCT: vorbis_info 
-    { "int" "version" }
-    { "int" "channels" }
-    { "long" "rate" }
-    { "long" "bitrate_upper" }
-    { "long" "bitrate_nominal" }
-    { "long" "bitrate_lower" }
-    { "long" "bitrate_window" }
-    { "void*" "codec_setup"} 
-    ;
-
-C-STRUCT: vorbis_dsp_state
-    { "int" "analysisp" }
-    { "vorbis_info*" "vi" }
-    { "float**" "pcm" }
-    { "float**" "pcmret" }
-    { "int" "pcm_storage" }
-    { "int" "pcm_current" }
-    { "int" "pcm_returned" }
-    { "int" "preextrapolate" }
-    { "int" "eofflag" }
-    { "long" "lW" }
-    { "long" "W" }
-    { "long" "nW" }
-    { "long" "centerW" }
-    { "longlong" "granulepos" }
-    { "longlong" "sequence" }
-    { "longlong" "glue_bits" }
-    { "longlong" "time_bits" }
-    { "longlong" "floor_bits" }
-    { "longlong" "res_bits" }
-    { "void*" "backend_state" }
-    ;
-
-C-STRUCT: alloc_chain
-    { "void*" "ptr" }
-    { "void*" "next" }
-    ;
-
-C-STRUCT: vorbis_block
-    { "float**" "pcm" }
-    { "oggpack_buffer" "opb" }
-    { "long" "lW" }
-    { "long" "W" }
-    { "long" "nW" }
-    { "int" "pcmend" }
-    { "int" "mode" }
-    { "int" "eofflag" }
-    { "longlong" "granulepos" }
-    { "longlong" "sequence" }
-    { "vorbis_dsp_state*" "vd" }
-    { "void*" "localstore" }
-    { "long" "localtop" }
-    { "long" "localalloc" }
-    { "long" "totaluse" }
-    { "alloc_chain*" "reap" }
-    { "long" "glue_bits" }
-    { "long" "time_bits" }
-    { "long" "floor_bits" }
-    { "long" "res_bits" }
-    { "void*" "internal" }
-    ;
-
-C-STRUCT: vorbis_comment
-    { "char**" "usercomments" }
-    { "int*" "comment_lengths" }
-    { "int" "comments" }
-    { "char*" "vendor" }
-    ;
-
-FUNCTION: void     vorbis_info_init ( vorbis_info* vi ) ;
-FUNCTION: void     vorbis_info_clear ( vorbis_info* vi ) ;
-FUNCTION: int      vorbis_info_blocksize ( vorbis_info* vi, int zo ) ;
-FUNCTION: void     vorbis_comment_init ( vorbis_comment* vc ) ;
-FUNCTION: void     vorbis_comment_add ( vorbis_comment* vc, char* comment ) ;
-FUNCTION: void     vorbis_comment_add_tag ( vorbis_comment* vc, char* tag, char* contents ) ;
-FUNCTION: char*    vorbis_comment_query ( vorbis_comment* vc, char* tag, int count ) ;
-FUNCTION: int      vorbis_comment_query_count ( vorbis_comment* vc, char* tag ) ;
-FUNCTION: void     vorbis_comment_clear ( vorbis_comment* vc ) ;
-FUNCTION: int      vorbis_block_init ( vorbis_dsp_state* v, vorbis_block* vb ) ;
-FUNCTION: int      vorbis_block_clear ( vorbis_block* vb ) ;
-FUNCTION: void     vorbis_dsp_clear ( vorbis_dsp_state* v ) ;
-FUNCTION: double   vorbis_granule_time ( vorbis_dsp_state* v, longlong granulepos ) ;
-FUNCTION: int      vorbis_analysis_init ( vorbis_dsp_state* v, vorbis_info* vi ) ;
-FUNCTION: int      vorbis_commentheader_out ( vorbis_comment* vc, ogg_packet* op ) ;
-FUNCTION: int      vorbis_analysis_headerout ( vorbis_dsp_state* v,
-                                          vorbis_comment* vc,
-                                          ogg_packet* op,
-                                          ogg_packet* op_comm,
-                                          ogg_packet* op_code ) ;
-FUNCTION: float**  vorbis_analysis_buffer ( vorbis_dsp_state* v, int vals ) ;
-FUNCTION: int      vorbis_analysis_wrote ( vorbis_dsp_state* v, int vals ) ;
-FUNCTION: int      vorbis_analysis_blockout ( vorbis_dsp_state* v, vorbis_block* vb ) ;
-FUNCTION: int      vorbis_analysis ( vorbis_block* vb, ogg_packet* op ) ;
-FUNCTION: int      vorbis_bitrate_addblock ( vorbis_block* vb ) ;
-FUNCTION: int      vorbis_bitrate_flushpacket ( vorbis_dsp_state* vd,
-                                           ogg_packet* op ) ;
-FUNCTION: int      vorbis_synthesis_headerin ( vorbis_info* vi, vorbis_comment* vc,
-                                          ogg_packet* op ) ;
-FUNCTION: int      vorbis_synthesis_init ( vorbis_dsp_state* v, vorbis_info* vi ) ;
-FUNCTION: int      vorbis_synthesis_restart ( vorbis_dsp_state* v ) ;
-FUNCTION: int      vorbis_synthesis ( vorbis_block* vb, ogg_packet* op ) ;
-FUNCTION: int      vorbis_synthesis_trackonly ( vorbis_block* vb, ogg_packet* op ) ;
-FUNCTION: int      vorbis_synthesis_blockin ( vorbis_dsp_state* v, vorbis_block* vb ) ;
-FUNCTION: int      vorbis_synthesis_pcmout ( vorbis_dsp_state* v, float*** pcm ) ;
-FUNCTION: int      vorbis_synthesis_lapout ( vorbis_dsp_state* v, float*** pcm ) ;
-FUNCTION: int      vorbis_synthesis_read ( vorbis_dsp_state* v, int samples ) ;
-FUNCTION: long     vorbis_packet_blocksize ( vorbis_info* vi, ogg_packet* op ) ;
-FUNCTION: int      vorbis_synthesis_halfrate ( vorbis_info* v, int flag ) ;
-FUNCTION: int      vorbis_synthesis_halfrate_p ( vorbis_info* v ) ;
-
-: OV_FALSE ( -- number ) -1 ; inline
-: OV_EOF ( -- number ) -2 ; inline
-: OV_HOLE ( -- number ) -3 ; inline
-: OV_EREAD ( -- number ) -128 ; inline
-: OV_EFAULT ( -- number ) -129 ; inline
-: OV_EIMPL ( -- number ) -130 ; inline
-: OV_EINVAL ( -- number ) -131 ; inline
-: OV_ENOTVORBIS ( -- number ) -132 ; inline
-: OV_EBADHEADER ( -- number ) -133 ; inline
-: OV_EVERSION ( -- number ) -134 ; inline
-: OV_ENOTAUDIO ( -- number ) -135 ; inline
-: OV_EBADPACKET ( -- number ) -136 ; inline
-: OV_EBADLINK ( -- number ) -137 ; inline
-: OV_ENOSEEK ( -- number ) -138 ; inline