<string>Factor</string>
<key>CFBundlePackageType</key>
<string>APPL</string>
+ <key>CFBundleVersion</key>
+ <string>0.93</string>
<key>NSHumanReadableCopyright</key>
- <string>Copyright © 2003-2009, Slava Pestov and friends</string>
+ <string>Copyright © 2003-2010 Factor developers</string>
<key>NSServices</key>
<array>
<dict>
AR = ar
LD = ld
- VERSION = 0.92
+ VERSION = 0.93
BUNDLE = Factor.app
LIBPATH = -L/usr/X11R6/lib
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.strings alien.c-types alien.data alien.accessors
arrays words sequences math kernel namespaces fry cpu.architecture
-io.encodings.utf8 accessors ;
+io.encodings.binary io.encodings.utf8 accessors ;
IN: alien.arrays
INSTANCE: array value-type
M: array stack-size drop void* stack-size ;
M: array c-type-boxer-quot
- unclip
- [ array-length ]
- [ [ require-c-array ] keep ] bi*
- [ <c-direct-array> ] 2curry ;
+ unclip [ array-length ] dip [ <c-direct-array> ] 2curry ;
M: array c-type-unboxer-quot drop [ >c-ptr ] ;
PREDICATE: string-type < pair
- first2 [ char* = ] [ word? ] bi* and ;
+ first2 [ c-string = ] [ word? ] bi* and ;
M: string-type c-type ;
drop void* c-type-unboxer ;
M: string-type c-type-boxer-quot
- second '[ _ alien>string ] ;
+ second dup binary =
+ [ drop void* c-type-boxer-quot ]
+ [ '[ _ alien>string ] ] if ;
M: string-type c-type-unboxer-quot
- second '[ _ string>alien ] ;
+ second dup binary =
+ [ drop void* c-type-unboxer-quot ]
+ [ '[ _ string>alien ] ] if ;
M: string-type c-type-getter
drop [ alien-cell ] ;
M: string-type c-type-setter
drop [ set-alien-cell ] ;
-{ char* utf8 } char* typedef
-char* uchar* typedef
+{ c-string utf8 } c-string typedef
-char char* "pointer-c-type" set-word-prop
-uchar uchar* "pointer-c-type" set-word-prop
QUALIFIED: sequences
IN: alien.c-types
-HELP: byte-length
-{ $values { "seq" "A byte array or float array" } { "n" "a non-negative integer" } }
-{ $contract "Outputs the size of the byte array, struct, or specialized array data in bytes." } ;
-
HELP: heap-size
{ $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." }
{ $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." } ;
-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" "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." } ;
+{ $errors "Throws a " { $link no-c-type } " error if the type does not exist, or the word is not a C type." } ;
HELP: c-getter
{ $values { "name" "a C type" } { "quot" { $quotation "( c-ptr n -- obj )" } } }
HELP: void
{ $description "This symbol is not a valid C type, but it can be used as the return type for a " { $link POSTPONE: FUNCTION: } " or " { $link POSTPONE: CALLBACK: } " definition or for an " { $link alien-invoke } " or " { $link alien-callback } " call." } ;
HELP: void*
-{ $description "This C type represents a pointer to C memory. " { $link byte-array } " and " { $link alien } " values can be passed as " { $snippet "void*" } " function inputs, but see " { $link "byte-arrays-gc" } " for notes about passing byte arrays into C functions. " { $snippet "void*" } " output values are returned as " { $link alien } "s." } ;
-HELP: char*
+{ $description "This C type represents a generic pointer to C memory. See " { $link pointer } " for information on pointer C types." } ;
+HELP: c-string
{ $description "This C type represents a pointer to a C string. See " { $link "c-strings" } " for details about using strings with the FFI." } ;
HELP: float
{ $description "This C type represents a single-precision IEEE 754 floating-point type. Input values will be converted to Factor " { $link math:float } "s and demoted to single-precision; output values will be returned as Factor " { $link math:float } "s." } ;
HELP: complex-double
{ $description "This C type represents a double-precision IEEE 754 floating-point complex type. Input values will be converted from Factor " { $link math:complex } " objects into a double-precision complex float type; output values will be returned as Factor " { $link math:complex } " objects." } ;
+HELP: pointer:
+{ $syntax "pointer: c-type" }
+{ $description "Constructs a " { $link pointer } " C type." } ;
+
+HELP: pointer
+{ $class-description "Represents a pointer C type. The " { $snippet "to" } " slot contains the C type being pointed to." { $link byte-array } " and " { $link alien } " values can be provided as pointer function inputs, but see " { $link "byte-arrays-gc" } " for notes about passing byte arrays into C functions. Objects with methods on " { $link >c-ptr } ", such as structs and specialized arrays, may also be used as pointer inputs."
+$nl
+"Pointer output values are represented in Factor as " { $link alien } "s. If the pointed-to type is a struct, the alien will automatically be wrapped in a struct object if it is not null."
+$nl
+"In " { $link POSTPONE: TYPEDEF: } ", " { $link POSTPONE: FUNCTION: } ", " { $link POSTPONE: CALLBACK: } ", and " { $link POSTPONE: STRUCT: } " definitions, pointer types can be created by suffixing " { $snippet "*" } " to a C type name. Outside of FFI definitions, a pointer C type can be created using the " { $link POSTPONE: pointer: } " syntax word:"
+{ $unchecked-example "FUNCTION: int* foo ( char* bar ) ;" }
+{ $unchecked-example """: foo ( bar -- int* )
+ pointer: int f \"foo\" { pointer: char } alien-invoke ;""" } } ;
ARTICLE: "byte-arrays-gc" "Byte arrays and the garbage collector"
"The Factor garbage collector can move byte arrays around, and it is only safe to pass byte arrays to C functions if the garbage collector will not run while C code still has a reference to the data."
"When making alien calls, Factor numbers are converted to and from the above types in a canonical way. Converting a Factor number to a C value may result in a loss of precision." ;
ARTICLE: "c-types.pointers" "Pointer and array types"
-"Pointer types are specified by suffixing a C type with " { $snippet "*" } ", for example " { $snippet "float*" } ". One special case is " { $link void* } ", which denotes a generic pointer; " { $link void } " by itself is not a valid C type specifier. With the exception of strings (see " { $link "c-strings" } "), all pointer types are identical to " { $snippet "void*" } " as far as the C library interface is concerned."
+"Pointer types are specified by suffixing a C type with " { $snippet "*" } ", for example " { $snippet "float*" } ". One special case is " { $link void* } ", which denotes a generic pointer; " { $link void } " by itself is not a valid C type specifier. This syntax constructs a " { $link pointer } " object to represent the C type."
$nl
"Fixed-size array types are supported; the syntax consists of a C type name followed by dimension sizes in brackets; the following denotes a 3 by 4 array of integers:"
{ $code "int[3][4]" }
-"Fixed-size arrays differ from pointers in that they are allocated inside structures and unions; however when used as function parameters they behave exactly like pointers and thus the dimensions only serve as documentation." ;
+"Fixed-size arrays differ from pointers in that they are allocated inside structures and unions; however, when used as function parameters, they behave exactly like pointers with the dimensions only serving as documentation." ;
ARTICLE: "c-types.ambiguity" "Word name clashes with C types"
"Note that some of the C type word names clash with commonly-used Factor words:"
"Struct and union types are identified by their class word. See " { $link "classes.struct" } "." ;
ARTICLE: "c-types-specs" "C type specifiers"
-"C types are identified by special words, and type names occur as parameters to the " { $link alien-invoke } ", " { $link alien-indirect } " and " { $link alien-callback } " words."
+"C types are identified by special words. Type names occur as parameters to the " { $link alien-invoke } ", " { $link alien-indirect } " and " { $link alien-callback } " words."
$nl
"Defining new C types:"
{ $subsections
USING: alien alien.syntax alien.c-types alien.parser
eval kernel tools.test sequences system libc alien.strings
-io.encodings.utf8 math.constants classes.struct classes
+io.encodings.ascii io.encodings.utf8 math.constants classes.struct classes
accessors compiler.units ;
IN: alien.c-types.tests
{ a int }
{ b int } ;
-[ f ] [ char resolve-pointer-type c-type void* c-type eq? ] unit-test
-[ t ] [ char* resolve-pointer-type c-type void* c-type eq? ] unit-test
+[ t ] [ pointer: void c-type void* c-type = ] unit-test
+[ t ] [ pointer: int c-type void* c-type = ] unit-test
+[ t ] [ pointer: int* c-type void* c-type = ] unit-test
+[ f ] [ pointer: foo c-type void* c-type = ] unit-test
+[ t ] [ pointer: foo* c-type void* c-type = ] unit-test
+
+[ t ] [ c-string c-type c-string c-type = ] unit-test
[ t ] [ foo heap-size int heap-size = ] unit-test
TYPEDEF: int MyInt
-[ t ] [ int c-type MyInt c-type eq? ] unit-test
-[ t ] [ void* c-type MyInt resolve-pointer-type c-type eq? ] unit-test
+[ t ] [ int c-type MyInt c-type = ] unit-test
+[ t ] [ void* c-type pointer: MyInt c-type = ] unit-test
+
+[ 32 ] [ { int 8 } heap-size ] unit-test
TYPEDEF: char MyChar
-[ t ] [ char c-type MyChar c-type eq? ] unit-test
-[ f ] [ void* c-type MyChar resolve-pointer-type c-type eq? ] unit-test
-[ t ] [ char* c-type MyChar resolve-pointer-type c-type eq? ] unit-test
+[ t ] [ pointer: void c-type pointer: MyChar c-type = ] unit-test
-[ 32 ] [ { int 8 } heap-size ] unit-test
+TYPEDEF: { c-string ascii } MyFunkyString
-TYPEDEF: char* MyString
+[ { c-string ascii } ] [ MyFunkyString c-type ] unit-test
-[ t ] [ char* c-type MyString c-type eq? ] unit-test
-[ t ] [ void* c-type MyString resolve-pointer-type c-type eq? ] unit-test
+TYPEDEF: c-string MyString
-TYPEDEF: int* MyIntArray
-
-[ t ] [ void* c-type MyIntArray c-type eq? ] unit-test
+[ t ] [ c-string c-type MyString c-type = ] unit-test
+[ t ] [ void* c-type pointer: MyString c-type = ] unit-test
-TYPEDEF: uchar* MyLPBYTE
+TYPEDEF: int* MyIntArray
-[ t ] [ { char* utf8 } c-type MyLPBYTE c-type = ] unit-test
+[ t ] [ void* c-type MyIntArray c-type = ] unit-test
[
0 B{ 1 2 3 4 } <displaced-alien> <void*>
C-TYPE: opaque
-[ t ] [ void* c-type opaque resolve-pointer-type c-type eq? ] unit-test
+[ t ] [ void* c-type pointer: opaque c-type = ] unit-test
[ opaque c-type ] [ no-c-type? ] must-fail-with
[ """
long ulong
longlong ulonglong
float double
- void* bool
- void ;
+ void* bool ;
+
+SINGLETON: void
DEFER: <int>
DEFER: *char
: <c-type> ( -- c-type )
\ c-type new ; inline
-SYMBOL: c-types
-
-global [
- c-types [ H{ } assoc-like ] change
-] bind
-
ERROR: no-c-type name ;
-PREDICATE: c-type-word < word
- "c-type" word-prop ;
-
-UNION: c-type-name string c-type-word ;
-
! C type protocol
GENERIC: c-type ( name -- c-type ) foldable
-GENERIC: resolve-pointer-type ( name -- c-type )
-
-<< \ void \ void* "pointer-c-type" set-word-prop >>
-
-: void? ( c-type -- ? )
- { void "void" } member? ;
-
-M: word resolve-pointer-type
- dup "pointer-c-type" word-prop
- [ ] [ drop void* ] ?if ;
+PREDICATE: c-type-word < word
+ "c-type" word-prop ;
-M: string resolve-pointer-type
- dup "*" append dup c-types get at
- [ nip ] [
- drop
- c-types get at dup c-type-name?
- [ resolve-pointer-type ] [ drop void* ] if
- ] if ;
+TUPLE: pointer { to initial: void read-only } ;
+C: <pointer> pointer
-M: array resolve-pointer-type
- first resolve-pointer-type ;
+UNION: c-type-name
+ c-type-word pointer ;
: resolve-typedef ( name -- c-type )
dup void? [ no-c-type ] when
dup c-type-name? [ c-type ] when ;
-<PRIVATE
-
-: parse-array-type ( name -- dims c-type )
- "[" split unclip
- [ [ "]" ?tail drop string>number ] map ] dip ;
-
-PRIVATE>
-
-M: string c-type ( name -- c-type )
- CHAR: ] over member? [
- parse-array-type prefix
- ] [
- dup c-types get at [ ] [
- "*" ?tail [ resolve-pointer-type ] [ no-c-type ] if
- ] ?if resolve-typedef
- ] if ;
-
M: word c-type
dup "c-type" word-prop resolve-typedef
[ ] [ no-c-type ] ?if ;
M: c-type stack-size size>> cell align ;
-GENERIC: byte-length ( seq -- n ) flushable
-
-M: byte-array byte-length length ; inline
-
-M: f byte-length drop 0 ; inline
-
: >c-bool ( ? -- int ) 1 0 ? ; inline
: c-bool> ( int -- ? ) 0 = not ; inline
\ swap , [ heap-size , [ * >fixnum ] % ] [ % ] bi*
] [ ] make ;
-GENERIC: typedef ( old new -- )
-
PREDICATE: typedef-word < c-type-word
"c-type" word-prop c-type-name? ;
-M: string typedef ( old new -- ) c-types get set-at ;
-
-M: word typedef ( old new -- )
+: typedef ( old new -- )
{
[ nip define-symbol ]
- [ name>> typedef ]
[ swap "c-type" set-word-prop ]
- [
- swap dup c-type-name? [
- resolve-pointer-type
- "pointer-c-type" set-word-prop
- ] [ 2drop ] if
- ]
} 2cleave ;
TUPLE: long-long-type < c-type ;
: if-void ( c-type true false -- )
pick void? [ drop nip call ] [ nip call ] if ; inline
+SYMBOLS:
+ ptrdiff_t intptr_t uintptr_t size_t
+ c-string ;
+
CONSTANT: primitive-types
{
char uchar
longlong ulonglong
float double
void* bool
+ c-string
}
-SYMBOLS:
- ptrdiff_t intptr_t uintptr_t size_t
- char* uchar* ;
+: (pointer-c-type) ( void* type -- void*' )
+ [ clone ] dip c-type-boxer-quot '[ _ [ f ] if* ] >>boxer-quot ;
+
+<PRIVATE
+
+: resolve-pointer-typedef ( type -- base-type )
+ dup "c-type" word-prop dup word?
+ [ nip resolve-pointer-typedef ] [
+ pointer? [ drop void* ] when
+ ] if ;
+
+: primitive-pointer-type? ( type -- ? )
+ dup c-type-word? [
+ resolve-pointer-typedef [ void? ] [ primitive-types member? ] bi or
+ ] [ drop t ] if ;
+
+PRIVATE>
+
+M: pointer c-type
+ [ \ void* c-type ] dip
+ to>> dup primitive-pointer-type? [ drop ] [ (pointer-c-type) ] if ;
: 8-byte-alignment ( c-type -- c-type )
{
\ uint c-type \ uintptr_t typedef
\ uint c-type \ size_t typedef
] if
+
] with-compilation-unit
M: char-16-rep rep-component-type drop char ;
[ C{ 1.0 2.0 } ] [ "h" get z>> ] unit-test
-[ complex ] [ "complex-float" c-type-boxed-class ] unit-test
+[ complex ] [ complex-float c-type-boxed-class ] unit-test
-[ complex ] [ "complex-double" c-type-boxed-class ] unit-test
+[ complex ] [ complex-double c-type-boxed-class ] unit-test
<<
{ "float" "double" } [ dup "complex-" prepend define-complex-type ] each
+>>
+<<
! This overrides the fact that small structures are never returned
! in registers on NetBSD, Linux and Solaris running on 32-bit x86.
-"complex-float" c-type t >>return-in-registers? drop
+\ complex-float c-type t >>return-in-registers? drop
>>
FUNCTOR: define-complex-type ( N T -- )
+N-type IS ${N}
+
T-class DEFINES-CLASS ${T}
<T> DEFINES <${T}>
WHERE
-STRUCT: T-class { real N } { imaginary N } ;
+STRUCT: T-class { real N-type } { imaginary N-type } ;
: <T> ( z -- alien )
>rect T-class <struct-boa> >c-ptr ;
{ $values { "alien" c-ptr } { "len" "a non-negative integer" } { "byte-array" byte-array } }
{ $description "Reads " { $snippet "len" } " bytes starting from " { $snippet "base" } " and stores them in a new byte array." } ;
-HELP: byte-array>memory
-{ $values { "byte-array" byte-array } { "base" c-ptr } }
-{ $description "Writes a byte array to memory starting from the " { $snippet "base" } " address." }
-{ $warning "This word is unsafe. Improper use can corrupt memory." } ;
-
HELP: malloc-array
{ $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> } "." }
"You can unsafely copy a range of bytes from one memory location to another:"
{ $subsections memcpy }
"You can copy a range of bytes from memory into a byte array:"
-{ $subsections memory>byte-array }
-"You can copy a byte array to memory unsafely:"
-{ $subsections byte-array>memory } ;
+{ $subsections memory>byte-array } ;
ARTICLE: "c-pointers" "Passing pointers to C functions"
"The following Factor objects may be passed to C function parameters with pointer types:"
{ "Instances of " { $link alien } "." }
{ "Instances of " { $link f } "; this is interpreted as a null pointer." }
{ "Instances of " { $link byte-array } "; the C function receives a pointer to the first element of the 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" } "." }
+ { "Any data type which defines a method on " { $link >c-ptr } ". This includes " { $link "classes.struct" } " and " { $link "specialized-arrays" } "." }
}
"The class of primitive C pointer types:"
{ $subsections c-ptr }
{ $subsections "byte-arrays-gc" }
"C-style enumerated types are supported:"
{ $subsections POSTPONE: C-ENUM: }
-"C types can be aliased for convenience and consitency with native library documentation:"
+"C types can be aliased for convenience and consistency with native library documentation:"
{ $subsections POSTPONE: TYPEDEF: }
"A utility for defining " { $link "destructors" } " for deallocating memory:"
{ $subsections "alien.destructors" }
{ $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." } ;
ARTICLE: "c-strings" "C strings"
-"C string types are arrays with shape " { $snippet "{ char* encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $link char* } " is an alias for " { $snippet "{ char* utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors."
+"C string types are arrays with shape " { $snippet "{ c-string encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $link c-string } " is an alias for " { $snippet "{ c-string utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors. In " { $link POSTPONE: TYPEDEF: } ", " { $link POSTPONE: FUNCTION: } ", " { $link POSTPONE: CALLBACK: } ", and " { $link POSTPONE: STRUCT: } " definitions, the shorthand syntax " { $snippet "c-string[encoding]" } " can be used to specify the string encoding."
$nl
-"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function."
+"Passing a Factor string to a C function expecting a " { $link c-string } " allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function."
$nl
"If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown."
$nl
-"Care must be taken if the C function expects a " { $link char* } " with a length in bytes, rather than a null-terminated " { $link char* } "; passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array."
+"Care must be taken if the C function expects a pointer to a string with its length represented by another parameter rather than a null terminator. Passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array."
$nl
"Sometimes a C function has a parameter type of " { $link void* } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:"
{ $subsections
}
"The first allocates " { $link byte-array } "s, and the latter allocates manually-managed memory which is not moved by the garbage collector and has to be explicitly freed by calling " { $link free } ". See " { $link "byte-arrays-gc" } " for a discussion of the two approaches."
$nl
+"The C type " { $link char } { $snippet "*" } " represents a generic pointer to " { $snippet "char" } "; arguments with this type will expect and return " { $link alien } "s, and won't perform any implicit string conversion."
+$nl
"A word to read strings from arbitrary addresses:"
{ $subsections alien>string }
-"For example, if a C function returns a " { $link char* } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $link void* } ", and call one of the above words before passing the pointer to " { $link free } "." ;
+"For example, if a C function returns a " { $link c-string } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "char*" } " and call one of the above words before passing the pointer to " { $link free } "." ;
-! (c)2009 Slava Pestov, Joe Groff bsd license
+! (c)2009, 2010 Slava Pestov, Joe Groff bsd license
USING: accessors alien alien.c-types alien.strings arrays
byte-arrays cpu.architecture fry io io.encodings.binary
-io.files io.streams.memory kernel libc math sequences words ;
+io.files io.streams.memory kernel libc math sequences words
+byte-vectors ;
IN: alien.data
GENERIC: require-c-array ( c-type -- )
heap-size malloc ; inline
: malloc-byte-array ( byte-array -- alien )
- dup byte-length [ nip malloc dup ] 2keep memcpy ;
+ binary-object [ nip malloc dup ] 2keep memcpy ;
: memory>byte-array ( alien len -- byte-array )
[ nip (byte-array) dup ] 2keep memcpy ;
swap memory>byte-array
] [ [ + ] change-index drop ] 2bi ;
-: byte-array>memory ( byte-array base -- )
- swap dup byte-length memcpy ; inline
+M: byte-vector stream-write
+ [ dup byte-length tail-slice ]
+ [ [ [ byte-length ] bi@ + ] keep lengthen ]
+ [ drop byte-length ]
+ 2tri
+ [ >c-ptr swap >c-ptr ] dip memcpy ;
M: value-type c-type-rep drop int-rep ;
classes.struct arrays assocs byte-arrays combinators fry
generalizations io.encodings.ascii kernel macros
macros.expander namespaces sequences shuffle tools.test vocabs.parser ;
+FROM: alien.syntax => pointer: ;
QUALIFIED-WITH: alien.c-types c
IN: alien.fortran.tests
! fortran-arg-type>c-type
- [ c:void* { } ]
+ [ pointer: c:int { } ]
[ "integer" fortran-arg-type>c-type ] unit-test
- [ c:void* { } ]
+ [ pointer: { c:int 3 } { } ]
[ "integer(3)" fortran-arg-type>c-type ] unit-test
- [ c:void* { } ]
+ [ pointer: { c:int 0 } { } ]
[ "integer(*)" fortran-arg-type>c-type ] unit-test
- [ c:void* { } ]
+ [ pointer: fortran_test_record { } ]
[
[
"alien.fortran.tests" use-vocab
] with-manifest
] unit-test
- [ c:char* { } ]
+ [ pointer: c:char { } ]
[ "character" fortran-arg-type>c-type ] unit-test
- [ c:char* { } ]
+ [ pointer: c:char { } ]
[ "character(1)" fortran-arg-type>c-type ] unit-test
- [ c:char* { long } ]
+ [ pointer: { c:char 17 } { long } ]
[ "character(17)" fortran-arg-type>c-type ] unit-test
! fortran-ret-type>c-type
[ c:char { } ]
[ "character(1)" fortran-ret-type>c-type ] unit-test
- [ c:void { c:char* long } ]
+ [ c:void { pointer: { c:char 17 } long } ]
[ "character(17)" fortran-ret-type>c-type ] unit-test
[ c:int { } ]
[ c:float { } ]
[ "real" fortran-ret-type>c-type ] unit-test
- [ c:void { c:void* } ]
+ [ c:void { pointer: { c:float 0 } } ]
[ "real(*)" fortran-ret-type>c-type ] unit-test
[ c:double { } ]
[ "double-precision" fortran-ret-type>c-type ] unit-test
- [ c:void { c:void* } ]
+ [ c:void { pointer: complex-float } ]
[ "complex" fortran-ret-type>c-type ] unit-test
- [ c:void { c:void* } ]
+ [ c:void { pointer: complex-double } ]
[ "double-complex" fortran-ret-type>c-type ] unit-test
- [ c:void { c:void* } ]
+ [ c:void { pointer: { c:int 0 } } ]
[ "integer(*)" fortran-ret-type>c-type ] unit-test
- [ c:void { c:void* } ]
+ [ c:void { pointer: fortran_test_record } ]
[
[
"alien.fortran.tests" use-vocab
! fortran-sig>c-sig
- [ c:float { c:void* c:char* c:void* c:void* c:long } ]
+ [ c:float { pointer: c:int pointer: { c:char 17 } pointer: c:float pointer: c:double c:long } ]
[ "real" { "integer" "character*17" "real" "real*8" } fortran-sig>c-sig ]
unit-test
- [ c:char { c:char* c:char* c:void* c:long } ]
+ [ c:char { pointer: { c:char 17 } pointer: c:char pointer: c:int c:long } ]
[ "character(1)" { "character*17" "character" "integer" } fortran-sig>c-sig ]
unit-test
- [ c:void { c:char* c:long c:char* c:char* c:void* c:long } ]
+ [ c:void { pointer: { c:char 18 } c:long pointer: { c:char 17 } pointer: c:char pointer: c:int c:long } ]
[ "character*18" { "character*17" "character" "integer" } fortran-sig>c-sig ]
unit-test
- [ c:void { c:void* c:char* c:char* c:void* c:long } ]
+ [ c:void { pointer: complex-float pointer: { c:char 17 } pointer: c:char pointer: c:int c:long } ]
[ "complex" { "character*17" "character" "integer" } fortran-sig>c-sig ]
unit-test
! [fortran-invoke]
[
c:void "funpack" "funtimes_"
- { c:char* c:void* c:void* c:void* c:void* c:long }
+ { pointer: { c:char 12 } pointer: c:longlong pointer: c:float pointer: complex-float pointer: c:short c:long }
alien-invoke
] 6 nkeep
! [fortran-results>]
[ { [ drop ] } spread ]
} 1 ncleave
! [fortran-invoke]
- [ c:float "funpack" "fun_times_" { void* } alien-invoke ]
+ [ c:float "funpack" "fun_times_" { pointer: { c:float 0 } } alien-invoke ]
1 nkeep
! [fortran-results>]
shuffle( reta aa -- reta aa )
! [fortran-invoke]
[
c:void "funpack" "fun_times_"
- { void* void* }
+ { pointer: complex-float pointer: { c:float 0 } }
alien-invoke
] 2 nkeep
! [fortran-results>]
! [fortran-invoke]
[
c:void "funpack" "fun_times_"
- { c:char* long }
+ { pointer: { c:char 20 } long }
alien-invoke
] 2 nkeep
! [fortran-results>]
! [fortran-invoke]
[
c:void "funpack" "fun_times_"
- { c:char* long c:char* c:void* c:char* c:long c:long }
+ { pointer: { c:char 10 } long pointer: { c:char 20 } pointer: c:float pointer: { c:char 30 } c:long c:long }
alien-invoke
] 7 nkeep
! [fortran-results>]
[ { c:char 1 } ]
[ "character(1)" fortran-type>c-type ] unit-test
- [ c:char* { c:long } ]
+ [ pointer: c:char { c:long } ]
[ "character" fortran-arg-type>c-type ] unit-test
- [ c:void { c:char* c:long } ]
+ [ c:void { pointer: c:char c:long } ]
[ "character" fortran-ret-type>c-type ] unit-test
[ c:double { } ]
[ "real" fortran-ret-type>c-type ] unit-test
- [ c:void { void* } ]
+ [ c:void { pointer: { c:float 0 } } ]
[ "real(*)" fortran-ret-type>c-type ] unit-test
[ "fun_" ] [ "FUN" fortran-name>symbol-name ] unit-test
[ c:float { } ]
[ "real" fortran-ret-type>c-type ] unit-test
- [ c:void { void* } ]
+ [ c:void { pointer: { c:float 0 } } ]
[ "real(*)" fortran-ret-type>c-type ] unit-test
[ complex-float { } ]
[ { char 1 } ]
[ "character(1)" fortran-type>c-type ] unit-test
- [ c:char* { c:long } ]
+ [ pointer: c:char { c:long } ]
[ "character" fortran-arg-type>c-type ] unit-test
- [ c:void { c:char* c:long } ]
+ [ c:void { pointer: c:char c:long } ]
[ "character" fortran-ret-type>c-type ] unit-test
[ complex-float { } ]
[ complex-double { } ]
[ "double-complex" fortran-ret-type>c-type ] unit-test
- [ c:void { c:void* } ]
+ [ c:void { pointer: { complex-double 3 } } ]
[ "double-complex(3)" fortran-ret-type>c-type ] unit-test
] with-variable
: fortran-arg-type>c-type ( fortran-type -- c-type added-args )
parse-fortran-type
- [ (fortran-type>c-type) resolve-pointer-type ]
+ [ (fortran-type>c-type) <pointer> ]
[ added-c-args ] bi ;
: fortran-ret-type>c-type ( fortran-type -- c-type added-args )
parse-fortran-type dup returns-by-value?
[ (fortran-ret-type>c-type) { } ] [
c:void swap
- [ added-c-args ] [ (fortran-type>c-type) resolve-pointer-type ] bi prefix
+ [ added-c-args ] [ (fortran-type>c-type) <pointer> ] bi prefix
] if ;
: fortran-arg-types>c-types ( fortran-types -- c-types )
}
"Note the parse time evaluation with " { $link POSTPONE: << } "." } ;
+HELP: deploy-library
+{ $values { "name" string } }
+{ $description "Specifies that the logical library named " { $snippet "name" } " should be included during " { $link "tools.deploy" } ". " { $snippet "name" } " must be the name of a library previously loaded with " { $link add-library } "." } ;
+
HELP: remove-library
{ $values { "name" string } }
{ $description "Unloads a library and removes it from the internal list of libraries. The " { $snippet "name" } " parameter should be a name that was previously passed to " { $link add-library } ". If no library with that name exists, this word does nothing." } ;
}
"Once a library has been defined, you can try loading it to see if the path name is correct:"
{ $subsections load-library }
-"If the compiler cannot load a library, or cannot resolve a symbol in a library, a linkage error is reported using the compiler error mechanism (see " { $link "compiler-errors" } "). Once you install the right library, reload the source file containing the " { $link add-library } " form to force the compiler to try loading the library again." ;
+"If the compiler cannot load a library, or cannot resolve a symbol in a library, a linkage error is reported using the compiler error mechanism (see " { $link "compiler-errors" } "). Once you install the right library, reload the source file containing the " { $link add-library } " form to force the compiler to try loading the library again."
+$nl
+"Libraries that do not come standard with the operating system need to be included with deployed applications that use them. A word is provided to instruct " { $link "tools.deploy" } " that a library must be so deployed:"
+{ $subsections
+ deploy-library
+} ;
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov, Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.strings assocs io.backend
-kernel namespaces destructors ;
+kernel namespaces destructors sequences system io.pathnames ;
IN: alien.libraries
: dlopen ( path -- dll ) native-string>alien (dlopen) ;
TUPLE: library path abi dll ;
+ERROR: no-library name ;
+
: library ( name -- library ) libraries get at ;
: <library> ( path abi -- library )
: add-library ( name path abi -- )
[ 2drop remove-library ]
- [ <library> swap libraries get set-at ] 3bi ;
\ No newline at end of file
+ [ <library> swap libraries get set-at ] 3bi ;
+
+: library-abi ( library -- abi )
+ library [ abi>> ] [ "cdecl" ] if* ;
+
+SYMBOL: deploy-libraries
+
+deploy-libraries [ V{ } clone ] initialize
+
+: deploy-library ( name -- )
+ dup libraries get key?
+ [ deploy-libraries get 2dup member? [ 2drop ] [ push ] if ]
+ [ no-library ] if ;
+
+<PRIVATE
+
+HOOK: >deployed-library-path os ( path -- path' )
+
+M: windows >deployed-library-path
+ file-name ;
+
+M: unix >deployed-library-path
+ file-name "$ORIGIN" prepend-path ;
+
+M: macosx >deployed-library-path
+ file-name "@executable_path/../Frameworks" prepend-path ;
+
+PRIVATE>
! (c)2009 Joe Groff bsd license
USING: accessors alien.c-types alien.parser alien.syntax
-tools.test vocabs.parser parser eval vocabs.parser debugger
-continuations ;
+tools.test vocabs.parser parser eval debugger kernel
+continuations words ;
IN: alien.parser.tests
TYPEDEF: char char2
[ { int 5 } ] [ "int[5]" parse-c-type ] unit-test
[ { int 5 10 11 } ] [ "int[5][10][11]" parse-c-type ] unit-test
[ { int 5 10 eleven } ] [ "int[5][10][eleven]" parse-c-type ] unit-test
- [ void* ] [ "int*" parse-c-type ] unit-test
- [ void* ] [ "int**" parse-c-type ] unit-test
- [ void* ] [ "int***" parse-c-type ] unit-test
- [ void* ] [ "int****" parse-c-type ] unit-test
- [ char* ] [ "char*" parse-c-type ] unit-test
- [ void* ] [ "char**" parse-c-type ] unit-test
- [ void* ] [ "char***" parse-c-type ] unit-test
- [ void* ] [ "char****" parse-c-type ] unit-test
+ [ pointer: void ] [ "void*" parse-c-type ] unit-test
+ [ pointer: int ] [ "int*" parse-c-type ] unit-test
+ [ pointer: int* ] [ "int**" parse-c-type ] unit-test
+ [ pointer: int** ] [ "int***" parse-c-type ] unit-test
+ [ pointer: int*** ] [ "int****" parse-c-type ] unit-test
+ [ c-string ] [ "c-string" parse-c-type ] unit-test
[ char2 ] [ "char2" parse-c-type ] unit-test
- [ char* ] [ "char2*" parse-c-type ] unit-test
+ [ pointer: char2 ] [ "char2*" parse-c-type ] unit-test
- [ "not-c-type" parse-c-type ] [ no-c-type? ] must-fail-with
[ "not-word" parse-c-type ] [ error>> no-word-error? ] must-fail-with
-
] with-file-vocabs
+FUNCTION: void* alien-parser-function-effect-test ( int *arg1 float arg2 ) ;
+[ (( arg1 arg2 -- void* )) ] [
+ \ alien-parser-function-effect-test "declared-effect" word-prop
+] unit-test
+
+CALLBACK: void* alien-parser-callback-effect-test ( int *arg1 float arg2 ) ;
+[ (( arg1 arg2 -- void* )) ] [
+ \ alien-parser-callback-effect-test "callback-effect" word-prop
+] unit-test
+
! Reported by mnestic
TYPEDEF: int alien-parser-test-int ! reasonably unique name...
-! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
+! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.parser
alien.libraries arrays assocs classes combinators
{
{ [ dup "void" = ] [ drop void ] }
{ [ CHAR: ] over member? ] [ parse-array-type parse-c-type-name prefix ] }
+ { [ "*" ?tail ] [ (parse-c-type) <pointer> ] }
{ [ dup search ] [ parse-c-type-name ] }
- { [ "**" ?tail ] [ drop void* ] }
- { [ "*" ?tail ] [ parse-c-type-name resolve-pointer-type ] }
[ dup search [ ] [ no-word ] ?if ]
} cond ;
: valid-c-type? ( c-type -- ? )
- { [ array? ] [ c-type-name? ] [ void? ] } 1|| ;
+ { [ array? ] [ c-type-word? ] [ pointer? ] [ void? ] } 1|| ;
: parse-c-type ( string -- type )
(parse-c-type) dup valid-c-type? [ no-c-type ] unless ;
: scan-c-type ( -- c-type )
- scan dup "{" =
- [ drop \ } parse-until >array ]
- [ parse-c-type ] if ;
+ scan {
+ { [ dup "{" = ] [ drop \ } parse-until >array ] }
+ { [ dup "pointer:" = ] [ drop scan-c-type <pointer> ] }
+ [ parse-c-type ]
+ } cond ;
: reset-c-type ( word -- )
dup "struct-size" word-prop
[ dup [ forget-class ] [ { "struct-size" } reset-props ] bi ] when
{
"c-type"
- "pointer-c-type"
"callback-effect"
"callback-library"
} reset-props ;
+ERROR: *-in-c-type-name name ;
+
+: validate-c-type-name ( name -- name )
+ dup "*" tail?
+ [ *-in-c-type-name ] when ;
+
: CREATE-C-TYPE ( -- word )
- scan current-vocab create {
+ scan validate-c-type-name current-vocab create {
[ fake-definition ]
[ set-word ]
[ reset-c-type ]
] bi
[ parse-c-type ] dip ;
+<PRIVATE
+GENERIC: return-type-name ( type -- name )
+
+M: object return-type-name drop "void" ;
+M: word return-type-name name>> ;
+M: pointer return-type-name to>> return-type-name CHAR: * suffix ;
+PRIVATE>
+
: parse-arglist ( parameters return -- types effect )
[
2 group [ first2 normalize-c-arg 2array ] map
unzip [ "," ?tail drop ] map
]
- [ [ { } ] [ 1array ] if-void ]
+ [ [ { } ] [ return-type-name 1array ] if-void ]
bi* <effect> ;
: function-quot ( return library function types -- quot )
'[ _ _ _ _ alien-invoke ] ;
-:: make-function ( return! library function! parameters -- word quot effect )
- return function normalize-c-arg function! return!
+:: make-function ( return library function parameters -- word quot effect )
+ return function normalize-c-arg :> ( return function )
function create-in dup reset-generic
return library function
parameters return parse-arglist [ function-quot ] dip ;
make-function define-declared ;
: callback-quot ( return types abi -- quot )
- [ [ ] 3curry dip alien-callback ] 3curry ;
-
-: library-abi ( lib -- abi )
- library [ abi>> ] [ "cdecl" ] if* ;
+ '[ [ _ _ _ ] dip alien-callback ] ;
-:: make-callback-type ( lib return! type-name! parameters -- word quot effect )
- return type-name normalize-c-arg type-name! return!
+:: make-callback-type ( lib return type-name parameters -- word quot effect )
+ return type-name normalize-c-arg :> ( return type-name )
type-name current-vocab create :> type-word
type-word [ reset-generic ] [ reset-c-type ] bi
void* type-word typedef
PREDICATE: alien-callback-type-word < typedef-word
"callback-effect" word-prop ;
-
M: c-type-word definition drop f ;
M: c-type-word declarations. drop ;
+<PRIVATE
+GENERIC: pointer-string ( pointer -- string/f )
+M: object pointer-string drop f ;
+M: word pointer-string name>> ;
+M: pointer pointer-string to>> pointer-string [ CHAR: * suffix ] [ f ] if* ;
+PRIVATE>
+
GENERIC: pprint-c-type ( c-type -- )
M: word pprint-c-type pprint-word ;
+M: pointer pprint-c-type
+ dup pointer-string
+ [ swap present-text ]
+ [ pprint* ] if* ;
M: wrapper pprint-c-type wrapped>> pprint-word ;
M: string pprint-c-type text ;
M: array pprint-c-type pprint* ;
+M: pointer pprint* \ pointer: pprint-word to>> pprint-c-type ;
+
M: typedef-word definer drop \ TYPEDEF: f ;
M: typedef-word synopsis*
IN: alien.remote-control
: eval-callback ( -- callback )
- void* { char* } "cdecl"
+ void* { c-string } "cdecl"
[ eval>string utf8 malloc-string ] alien-callback ;
: yield-callback ( -- callback )
}
"You can define a word for invoking it:"
{ $unchecked-example
- "LIBRARY: foo\nFUNCTION: void the_answer ( char* question, int value ) ;"
- "USE: compiler"
+ "LIBRARY: foo\nFUNCTION: void the_answer ( c-string question, int value ) ;"
"\"the question\" 42 the_answer"
"The answer to the question is 42."
} }
+"Using the " { $link c-string } " type instead of " { $snippet "char*" } " causes the FFI to automatically convert Factor strings to C strings. See " { $link "c-strings" } " for more information on using strings with the FFI."
{ $notes "Note that the parentheses and commas are only syntax sugar and can be omitted; they serve no purpose other than to make the declaration slightly easier to read:"
{ $code
"FUNCTION: void glHint ( GLenum target, GLenum mode ) ;"
HELP: TYPEDEF:
{ $syntax "TYPEDEF: old new" }
{ $values { "old" "a C type" } { "new" "a C type" } }
-{ $description "Aliases the C type " { $snippet "old" } " under the name " { $snippet "new" } " if ." }
+{ $description "Aliases the C type " { $snippet "old" } " under the name " { $snippet "new" } "." }
{ $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-ENUM:
HELP: C-TYPE:
{ $syntax "C-TYPE: type" }
{ $values { "type" "a new C type" } }
-{ $description "Defines a new, opaque C type. Since it is opaque, " { $snippet "type" } " will not be directly usable as a parameter or return type of a " { $link POSTPONE: FUNCTION: } " or as a slot of a " { $link POSTPONE: STRUCT: } ". However, it can be used as the type of a pointer (that is, as " { $snippet "type*" } ")." $nl
-{ $snippet "C-TYPE:" } " can also be used to forward-declare C types to enable circular dependencies. For example:"
+{ $description "Defines a new, opaque C type. Since it is opaque, " { $snippet "type" } " will not be directly usable as a parameter or return type of a " { $link POSTPONE: FUNCTION: } " or as a slot of a " { $link POSTPONE: STRUCT: } ". However, it can be used as the type of a " { $link pointer } "."
+{ $snippet "C-TYPE:" } " can also be used to forward declare C types, allowing circular dependencies to occur between types. For example:"
{ $code """C-TYPE: forward
STRUCT: backward { x forward* } ;
STRUCT: forward { x backward* } ; """ } }
-{ $notes "Primitive C types are also displayed using " { $snippet "C-TYPE:" } " syntax when they are displayed by " { $link see } "." } ;
+{ $notes "Primitive C types are displayed using " { $snippet "C-TYPE:" } " syntax when they are " { $link see } "n." } ;
HELP: CALLBACK:
{ $syntax "CALLBACK: return type ( parameters ) ;" }
[ nip ] [ global-quot ] 2bi (( -- value )) define-declared ;
SYNTAX: C-GLOBAL: scan-c-type CREATE-WORD define-global ;
+
+SYNTAX: pointer:
+ scan-c-type <pointer> suffix! ;
! See http://factorcode.org/license.txt for BSD license.
USING: combinators io io.binary io.encodings.binary
io.streams.byte-array kernel math namespaces
-sequences strings io.crlf ;
+sequences strings ;
IN: base64
ERROR: malformed-base64 ;
: write1-lines ( ch -- )
write1
column get [
- 1 + [ 76 = [ crlf ] when ]
+ 1 + [ 76 = [ B{ CHAR: \r CHAR: \n } write ] when ]
[ 76 mod column set ] bi
] when* ;
! Copyright (C) 2007, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types alien.data accessors math alien.accessors kernel
+USING: alien alien.data accessors math alien.accessors kernel
kernel.private sequences sequences.private byte-arrays
parser prettyprint.custom fry ;
IN: bit-arrays
LIBRARY: cairo
FUNCTION: int cairo_version ( ) ;
-FUNCTION: char* cairo_version_string ( ) ;
+FUNCTION: c-string cairo_version_string ( ) ;
TYPEDEF: int cairo_bool_t
TYPEDEF: void* cairo_destroy_func_t
: cairo-destroy-func ( quot -- callback )
- [ void { void* } "cdecl" ] dip alien-callback ; inline
+ [ void { pointer: void } "cdecl" ] dip alien-callback ; inline
! See cairo.h for details
STRUCT: cairo_user_data_key_t
TYPEDEF: void* cairo_write_func_t
: cairo-write-func ( quot -- callback )
- [ cairo_status_t { void* uchar* int } "cdecl" ] dip alien-callback ; inline
+ [ cairo_status_t { pointer: void c-string int } "cdecl" ] dip alien-callback ; inline
TYPEDEF: void* cairo_read_func_t
: cairo-read-func ( quot -- callback )
- [ cairo_status_t { void* uchar* int } "cdecl" ] dip alien-callback ; inline
+ [ cairo_status_t { pointer: void c-string int } "cdecl" ] dip alien-callback ; inline
! Functions for manipulating state objects
FUNCTION: cairo_t*
! font object inside the the cairo_t.
FUNCTION: void
-cairo_select_font_face ( cairo_t* cr, char* family, cairo_font_slant_t slant, cairo_font_weight_t weight ) ;
+cairo_select_font_face ( cairo_t* cr, c-string family, cairo_font_slant_t slant, cairo_font_weight_t weight ) ;
FUNCTION: void
cairo_set_font_size ( cairo_t* cr, double size ) ;
cairo_get_scaled_font ( cairo_t* cr ) ;
FUNCTION: void
-cairo_show_text ( cairo_t* cr, char* utf8 ) ;
+cairo_show_text ( cairo_t* cr, c-string utf8 ) ;
FUNCTION: void
cairo_show_glyphs ( cairo_t* cr, cairo_glyph_t* glyphs, int num_glyphs ) ;
FUNCTION: void
-cairo_text_path ( cairo_t* cr, char* utf8 ) ;
+cairo_text_path ( cairo_t* cr, c-string utf8 ) ;
FUNCTION: void
cairo_glyph_path ( cairo_t* cr, cairo_glyph_t* glyphs, int num_glyphs ) ;
FUNCTION: void
-cairo_text_extents ( cairo_t* cr, char* utf8, cairo_text_extents_t* extents ) ;
+cairo_text_extents ( cairo_t* cr, c-string utf8, cairo_text_extents_t* extents ) ;
FUNCTION: void
cairo_glyph_extents ( cairo_t* cr, cairo_glyph_t* glyphs, int num_glyphs, cairo_text_extents_t* extents ) ;
cairo_scaled_font_extents ( cairo_scaled_font_t* scaled_font, cairo_font_extents_t* extents ) ;
FUNCTION: void
-cairo_scaled_font_text_extents ( cairo_scaled_font_t* scaled_font, char* utf8, cairo_text_extents_t* extents ) ;
+cairo_scaled_font_text_extents ( cairo_scaled_font_t* scaled_font, c-string utf8, cairo_text_extents_t* extents ) ;
FUNCTION: void
cairo_scaled_font_glyph_extents ( cairo_scaled_font_t* scaled_font, cairo_glyph_t* glyphs, int num_glyphs, cairo_text_extents_t* extents ) ;
FUNCTION: cairo_status_t
cairo_status ( cairo_t* cr ) ;
-FUNCTION: char*
+FUNCTION: c-string
cairo_status_to_string ( cairo_status_t status ) ;
! Surface manipulation
cairo_surface_get_content ( cairo_surface_t* surface ) ;
FUNCTION: cairo_status_t
-cairo_surface_write_to_png ( cairo_surface_t* surface, char* filename ) ;
+cairo_surface_write_to_png ( cairo_surface_t* surface, c-string filename ) ;
FUNCTION: cairo_status_t
cairo_surface_write_to_png_stream ( cairo_surface_t* surface, cairo_write_func_t write_func, void* closure ) ;
cairo_format_stride_for_width ( cairo_format_t format, int width ) ;
FUNCTION: cairo_surface_t*
-cairo_image_surface_create_for_data ( uchar* data, cairo_format_t format, int width, int height, int stride ) ;
+cairo_image_surface_create_for_data ( char* data, cairo_format_t format, int width, int height, int stride ) ;
FUNCTION: uchar*
cairo_image_surface_get_data ( cairo_surface_t* surface ) ;
cairo_image_surface_get_stride ( cairo_surface_t* surface ) ;
FUNCTION: cairo_surface_t*
-cairo_image_surface_create_from_png ( char* filename ) ;
+cairo_image_surface_create_from_png ( c-string filename ) ;
FUNCTION: cairo_surface_t*
cairo_image_surface_create_from_png_stream ( cairo_read_func_t read_func, void* closure ) ;
} ;
HELP: convert-timezone
-{ $values { "timestamp" timestamp } { "duration" duration } { "timestamp" timestamp } }
+{ $values { "timestamp" timestamp } { "duration" duration } { "timestamp'" timestamp } }
{ $description "Converts the " { $snippet "timestamp" } "'s " { $snippet "gmt-offset" } " to the GMT offset represented by the " { $snippet "duration" } "." }
{ $examples
{ $example "USING: accessors calendar prettyprint ;"
} ;
HELP: >local-time
-{ $values { "timestamp" timestamp } { "timestamp" timestamp } }
+{ $values { "timestamp" timestamp } { "timestamp'" timestamp } }
{ $description "Converts the " { $snippet "timestamp" } " to the timezone of your computer." }
{ $examples
{ $example "USING: accessors calendar kernel prettyprint ;"
} ;
HELP: >gmt
-{ $values { "timestamp" timestamp } { "timestamp" timestamp } }
+{ $values { "timestamp" timestamp } { "timestamp'" timestamp } }
{ $description "Converts the " { $snippet "timestamp" } " to the GMT timezone." }
{ $examples
{ $example "USING: accessors calendar kernel prettyprint ;"
GENERIC: time- ( time1 time2 -- time3 )
-: convert-timezone ( timestamp duration -- timestamp )
+: convert-timezone ( timestamp duration -- timestamp' )
over gmt-offset>> over = [ drop ] [
[ over gmt-offset>> time- time+ ] keep >>gmt-offset
] if ;
-: >local-time ( timestamp -- timestamp )
+: >local-time ( timestamp -- timestamp' )
gmt-offset-duration convert-timezone ;
-: >gmt ( timestamp -- timestamp )
+: >gmt ( timestamp -- timestamp' )
instant convert-timezone ;
M: timestamp <=> ( ts1 ts2 -- n )
+++ /dev/null
-unportable
timespec>seconds since-1970 ;
: get-time ( -- alien )
- f time <time_t> localtime tm memory>struct ;
+ f time <time_t> localtime ;
: timezone-name ( -- string )
get-time zone>> ;
+++ /dev/null
-unportable
"A C function which returns a struct by value:"
{ $code
"USING: alien.syntax ;"
- "FUNCTION: Point give_me_a_point ( char* description ) ;"
+ "FUNCTION: Point give_me_a_point ( c-string description ) ;"
}
"A C function which takes a struct parameter by reference:"
{ $code
! (c)Joe Groff bsd license
-USING: accessors alien alien.c-types alien.data ascii
-assocs byte-arrays classes.struct classes.tuple.private
-combinators compiler.tree.debugger compiler.units destructors
-io.encodings.utf8 io.pathnames io.streams.string kernel libc
-literals math mirrors namespaces prettyprint
-prettyprint.config see sequences specialized-arrays system
-tools.test parser lexer eval layouts ;
+USING: accessors alien alien.c-types alien.data alien.syntax ascii
+assocs byte-arrays classes.struct classes.tuple.parser
+classes.tuple.private classes.tuple combinators compiler.tree.debugger
+compiler.units destructors io.encodings.utf8 io.pathnames
+io.streams.string kernel libc literals math mirrors namespaces
+prettyprint prettyprint.config see sequences specialized-arrays system
+tools.test parser lexer eval layouts generic.single classes ;
FROM: math => float ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: char
[ 123 ] [ [ struct-test-foo malloc-struct &free y>> ] with-destructors ] unit-test
STRUCT: struct-test-string-ptr
- { x char* } ;
+ { x c-string } ;
[ "hello world" ] [
[
{ type bool }
{ class object }
}
-} ] [ "struct-test-foo" c-type fields>> ] unit-test
+} ] [ struct-test-foo c-type fields>> ] unit-test
[ {
T{ struct-slot-spec
{ class integer }
{ initial 0 }
}
-} ] [ "struct-test-float-and-bits" c-type fields>> ] unit-test
+} ] [ struct-test-float-and-bits c-type fields>> ] unit-test
STRUCT: struct-test-equality-1
{ x int } ;
"struct-class-test-1" parse-stream
] [ error>> error>> unexpected-eof? ] must-fail-with
+[
+ "USING: alien.c-types classes.struct ; IN: classes.struct.tests STRUCT: struct-test-duplicate-slots { x uint } { x uint } ;" eval( -- )
+] [ error>> duplicate-slot-names? ] must-fail-with
+
+[
+ "USING: alien.c-types classes.struct ; IN: classes.struct.tests STRUCT: struct-test-duplicate-slots { x uint } { x float } ;" eval( -- )
+] [ error>> duplicate-slot-names? ] must-fail-with
+
! S{ with non-struct type
[
"USE: classes.struct IN: classes.struct.tests TUPLE: not-a-struct ; S{ not-a-struct }"
eval( -- value )
-] must-fail
+] [ error>> no-method? ] must-fail-with
! Subclassing a struct class should not be allowed
[
- "USE: classes.struct IN: classes.struct.tests STRUCT: a-struct { x int } ; TUPLE: not-a-struct < a-struct ;"
+ "USING: alien.c-types classes.struct ; IN: classes.struct.tests STRUCT: a-struct { x int } ; TUPLE: not-a-struct < a-struct ;"
eval( -- )
-] must-fail
+] [ error>> bad-superclass? ] must-fail-with
-! Remove c-type when struct class is forgotten
-[ ] [
- "USE: classes.struct IN: classes.struct.tests TUPLE: a-struct ;" eval( -- )
-] unit-test
+! Changing a superclass into a struct should reset the subclass
+TUPLE: will-become-struct ;
+
+TUPLE: a-subclass < will-become-struct ;
+
+[ f ] [ will-become-struct struct-class? ] unit-test
+
+[ will-become-struct ] [ a-subclass superclass ] unit-test
+
+[ ] [ "IN: classes.struct.tests USING: classes.struct alien.c-types ; STRUCT: will-become-struct { x int } ;" eval( -- ) ] unit-test
-[ f ] [ "a-struct" c-types get key? ] unit-test
+[ t ] [ will-become-struct struct-class? ] unit-test
+
+[ tuple ] [ a-subclass superclass ] unit-test
STRUCT: bit-field-test
{ a uint bits: 12 }
[ 1 ] [ bit-field-test <struct> 257 >>c c>> ] unit-test
[ 3 ] [ bit-field-test heap-size ] unit-test
+STRUCT: referent
+ { y int } ;
+STRUCT: referrer
+ { x referent* } ;
+
+[ 57 ] [
+ [
+ referrer <struct>
+ referent malloc-struct &free
+ 57 >>y
+ >>x
+ x>> y>>
+ ] with-destructors
+] unit-test
+
+STRUCT: self-referent
+ { x self-referent* }
+ { y int } ;
+
+[ 75 ] [
+ [
+ self-referent <struct>
+ self-referent malloc-struct &free
+ 75 >>y
+ >>x
+ x>> y>>
+ ] with-destructors
+] unit-test
+
+C-TYPE: forward-referent
+STRUCT: backward-referent
+ { x forward-referent* }
+ { y int } ;
+STRUCT: forward-referent
+ { x backward-referent* }
+ { y int } ;
+
+[ 41 ] [
+ [
+ forward-referent <struct>
+ backward-referent malloc-struct &free
+ 41 >>y
+ >>x
+ x>> y>>
+ ] with-destructors
+] unit-test
+
+[ 14 ] [
+ [
+ backward-referent <struct>
+ forward-referent malloc-struct &free
+ 14 >>y
+ >>x
+ x>> y>>
+ ] with-destructors
+] unit-test
+
cpu ppc? [
STRUCT: ppc-align-test-1
{ x longlong }
locals macros make math math.order parser quotations sequences
slots slots.private specialized-arrays vectors words summary
namespaces assocs vocabs.parser math.functions
-classes.struct.bit-accessors bit-arrays ;
+classes.struct.bit-accessors bit-arrays
+stack-checker.dependencies ;
QUALIFIED: math
IN: classes.struct
PREDICATE: struct-class < tuple-class
superclass \ struct eq? ;
-M: struct-class valid-superclass? drop f ;
-
SLOT: fields
: struct-slots ( struct-class -- slots )
M: struct equal?
{
[ [ class ] bi@ = ]
- [ [ >c-ptr ] [ [ >c-ptr ] [ byte-length ] bi ] bi* memory= ]
+ [ [ >c-ptr ] [ binary-object ] bi* memory= ]
} 2&& ; inline
M: struct hashcode*
- [ >c-ptr ] [ byte-length ] bi <direct-uchar-array> hashcode* ; inline
+ binary-object <direct-uchar-array> hashcode* ; inline
: struct-prototype ( class -- prototype ) "prototype" word-prop ; foldable
: (unboxer-quot) ( class -- quot )
drop [ >c-ptr ] ;
+
+MACRO: read-struct-slot ( slot -- )
+ dup type>> depends-on-c-type
+ (reader-quot) ;
+
+MACRO: write-struct-slot ( slot -- )
+ dup type>> depends-on-c-type
+ (writer-quot) ;
PRIVATE>
M: struct-class boa>object
swap pad-struct-slots
- [ <struct> ] [ struct-slots ] bi
+ [ <struct> ] [ struct-slots ] bi
[ [ (writer-quot) call( value struct -- ) ] with 2each ] curry keep ;
M: struct-class initial-value* <struct> ; inline
GENERIC: struct-slot-values ( struct -- sequence )
M: struct-class reader-quot
- nip (reader-quot) ;
+ dup type>> array? [ dup type>> first define-array-vocab drop ] when
+ nip '[ _ read-struct-slot ] ;
M: struct-class writer-quot
- nip (writer-quot) ;
+ nip '[ _ write-struct-slot ] ;
: offset-of ( field struct -- offset )
struct-slots slot-named offset>> ; inline
define-inline-method ;
: clone-underlying ( struct -- byte-array )
- [ >c-ptr ] [ byte-length ] bi memory>byte-array ; inline
+ binary-object memory>byte-array ; inline
: (define-clone-method) ( class -- )
[ \ clone ]
[ type>> c-type drop ] each ;
: redefine-struct-tuple-class ( class -- )
- [ dup class? [ forget-class ] [ drop ] if ] [ struct f define-tuple-class ] bi ;
+ [ struct f define-tuple-class ] [ make-final ] bi ;
:: (define-struct-class) ( class slots offsets-quot -- )
slots empty? [ struct-must-have-slots ] when
: define-union-struct-class ( class slots -- )
[ compute-union-offsets ] (define-struct-class) ;
-M: struct-class reset-class
- [ call-next-method ] [ name>> c-types get delete-at ] bi ;
-
ERROR: invalid-struct-slot token ;
: struct-slot-class ( c-type -- class' )
<PRIVATE
: parse-struct-slot ( -- slot )
scan scan-c-type \ } parse-until <struct-slot-spec> ;
-
+
: parse-struct-slots ( slots -- slots' more? )
scan {
{ ";" [ f ] }
} case ;
: parse-struct-definition ( -- class slots )
- CREATE-CLASS 8 <vector> [ parse-struct-slots ] [ ] while >array ;
+ CREATE-CLASS 8 <vector> [ parse-struct-slots ] [ ] while >array
+ dup [ name>> ] map check-duplicate-slots ;
PRIVATE>
SYNTAX: STRUCT:
+++ /dev/null
-unportable
! Copyright (C) 2005, 2006 Kevin Reid.
! See http://factorcode.org/license.txt for BSD license.
-USING: assocs kernel namespaces cocoa cocoa.classes
-cocoa.subclassing debugger ;
+USING: alien.c-types assocs kernel namespaces cocoa
+cocoa.classes cocoa.runtime cocoa.subclassing debugger ;
IN: cocoa.callbacks
SYMBOL: callbacks
+++ /dev/null
-unportable
[
{
+ "NSAlert"
"NSApplication"
"NSArray"
"NSAutoreleasePool"
+++ /dev/null
-unportable
+++ /dev/null
-unportable
: super-send ( receiver args... selector -- return... ) t (send) ; inline
! Runtime introspection
-SYMBOL: class-startup-hooks
+SYMBOL: class-init-hooks
-class-startup-hooks [ H{ } clone ] initialize
+class-init-hooks [ H{ } clone ] initialize
: (objc-class) ( name word -- class )
2dup execute dup [ 2nip ] [
- drop over class-startup-hooks get at [ call( -- ) ] when*
+ drop over class-init-hooks get at [ call( -- ) ] when*
2dup execute dup [ 2nip ] [
2drop "No such class: " prepend throw
] if
{ "d" c:double }
{ "B" c:bool }
{ "v" c:void }
- { "*" c:char* }
+ { "*" c:c-string }
{ "?" unknown_type }
{ "@" id }
{ "#" Class }
: class-exists? ( string -- class ) objc_getClass >boolean ;
: define-objc-class-word ( quot name -- )
- [ class-startup-hooks get set-at ]
+ [ class-init-hooks get set-at ]
[
[ "cocoa.classes" create ] [ '[ _ objc-class ] ] bi
(( -- class )) define-declared
] bi ;
: import-objc-class ( name quot -- )
- over define-objc-class-word
- [ objc-class register-objc-methods ]
- [ objc-meta-class register-objc-methods ] bi ;
+ 2dup swap define-objc-class-word
+ over class-exists? [ drop ] [ call( -- ) ] if
+ dup class-exists? [
+ [ objc_getClass register-objc-methods ]
+ [ objc_getMetaClass register-objc-methods ] bi
+ ] [ drop ] if ;
: root-class ( class -- root )
dup class_getSuperclass [ root-class ] [ ] ?if ;
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
TYPEDEF: void* id
-FUNCTION: char* sel_getName ( SEL aSelector ) ;
+FUNCTION: c-string sel_getName ( SEL aSelector ) ;
FUNCTION: char sel_isMapped ( SEL aSelector ) ;
-FUNCTION: SEL sel_registerName ( char* str ) ;
+FUNCTION: SEL sel_registerName ( c-string str ) ;
TYPEDEF: void* Class
TYPEDEF: void* Method
FUNCTION: int objc_getClassList ( void* buffer, int bufferLen ) ;
-FUNCTION: Class objc_getClass ( char* class ) ;
+FUNCTION: Class objc_getClass ( c-string class ) ;
-FUNCTION: Class objc_getMetaClass ( char* class ) ;
+FUNCTION: Class objc_getMetaClass ( c-string class ) ;
-FUNCTION: Protocol objc_getProtocol ( char* class ) ;
+FUNCTION: Protocol objc_getProtocol ( c-string class ) ;
-FUNCTION: Class objc_allocateClassPair ( Class superclass, char* name, size_t extraBytes ) ;
+FUNCTION: Class objc_allocateClassPair ( Class superclass, c-string name, size_t extraBytes ) ;
FUNCTION: void objc_registerClassPair ( Class cls ) ;
FUNCTION: id class_createInstance ( Class class, uint additionalByteCount ) ;
FUNCTION: Class class_getSuperclass ( Class cls ) ;
-FUNCTION: char* class_getName ( Class cls ) ;
+FUNCTION: c-string class_getName ( Class cls ) ;
FUNCTION: char class_addMethod ( Class class, SEL name, void* imp, void* types ) ;
FUNCTION: uint method_getSizeOfArguments ( Method method ) ;
-FUNCTION: uint method_getArgumentInfo ( Method method, int argIndex, char** type, int* offset ) ;
+FUNCTION: uint method_getArgumentInfo ( Method method, int argIndex, c-string* type, int* offset ) ;
FUNCTION: void* method_copyReturnType ( Method method ) ;
+++ /dev/null
-unportable
+++ /dev/null
-unportable
-unportable
bindings
+ffi
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
--- /dev/null
+USING: compiler.crossref fry kernel sequences tools.test vocabs words ;
+IN: compiler.crossref.tests
+
+! Dependencies of all words should always be satisfied unless we're
+! in the middle of recompiling something
+[ { } ] [
+ all-words dup [ subwords ] map concat append
+ H{ } clone '[ _ dependencies-satisfied? not ] filter
+] unit-test
[ 11 6 ] [ 11 6 ffi_test_14 [ x>> ] [ y>> ] bi ] unit-test
-FUNCTION: char* ffi_test_15 char* x char* y ;
+FUNCTION: c-string ffi_test_15 c-string x c-string y ;
[ "foo" ] [ "xy" "zt" ffi_test_15 ] unit-test
[ "bar" ] [ "xy" "xy" ffi_test_15 ] unit-test
! Reported by jedahu
STRUCT: bool-field-test
- { name char* }
+ { name c-string }
{ on bool }
{ parents short } ;
--- /dev/null
+IN: compiler.tests.redefine22
+USING: kernel sequences compiler.units vocabs tools.test definitions ;
+
+TUPLE: ttt ;
+INSTANCE: ttt sequence
+M: ttt new-sequence 2drop ttt new ;
+
+: www-1 ( a -- b ) T{ ttt } new-sequence ;
+
+! This used to break with a compiler error in the above word
+[ ] [ [ \ ttt forget ] with-compilation-unit ] unit-test
--- /dev/null
+IN: compiler.tests.redefine23
+USING: classes.struct specialized-arrays alien.c-types sequences
+compiler.units vocabs tools.test ;
+
+STRUCT: my-struct { x int } ;
+SPECIALIZED-ARRAY: my-struct
+: my-word ( a -- b ) iota [ my-struct <struct-boa> ] my-struct-array{ } map-as ;
+
+[ ] [
+ [
+ "specialized-arrays.instances.compiler.tests.redefine23" forget-vocab
+ ] with-compilation-unit
+] unit-test
--- /dev/null
+USING: alien alien.syntax eval math tools.test ;
+QUALIFIED: alien.c-types
+IN: compiler.tests.redefine24
+
+TYPEDEF: alien.c-types:int type-1
+
+TYPEDEF: alien.c-types:int type-3
+
+: callback ( -- ptr )
+ type-3 { type-1 type-1 } "cdecl" [ + >integer ] alien-callback ;
+
+TYPEDEF: alien.c-types:float type-2
+
+: indirect ( x y ptr -- z )
+ type-3 { type-2 type-2 } "cdecl" alien-indirect ;
+
+[ ] [
+ "USING: alien.c-types alien.syntax ;
+ IN: compiler.tests.redefine24 TYPEDEF: int type-2" eval( -- )
+] unit-test
+
+[ 3 ] [ 1 2 callback indirect ] unit-test
+
+[ ] [
+ "USING: alien.c-types alien.syntax ;
+ IN: compiler.tests.redefine24
+ TYPEDEF: float type-1
+ TYPEDEF: float type-2" eval( -- )
+] unit-test
+
+[ 3 ] [ 1.0 2.0 callback indirect ] unit-test
+
+[ ] [
+ "USING: alien.c-types alien.syntax ;
+ IN: compiler.tests.redefine24
+ TYPEDEF: float type-3" eval( -- )
+] unit-test
+
+[ 3.0 ] [ 1.0 2.0 callback indirect ] unit-test
[ in-d>> #drop ]
bi prefix ;
-: record-predicate-folding ( #call -- )
- [ node-input-infos first class>> ]
+: >predicate-folding< ( #call -- value-info class result )
+ [ node-input-infos first ]
[ word>> "predicating" word-prop ]
- [ node-output-infos first literal>> ] tri
- [ depends-on-class<= ] [ depends-on-classes-disjoint ] if ;
+ [ node-output-infos first literal>> ] tri ;
+
+: record-predicate-folding ( #call -- )
+ >predicate-folding< pick literal?>>
+ [ [ literal>> ] 2dip depends-on-instance-predicate ]
+ [ [ class>> ] 2dip depends-on-class-predicate ]
+ if ;
: record-folding ( #call -- )
dup word>> predicate?
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs classes classes.algebra classes.tuple
-classes.tuple.private kernel accessors math math.intervals namespaces
-sequences sequences.private words combinators memoize
-combinators.short-circuit byte-arrays strings arrays layouts
-cpu.architecture compiler.tree.propagation.copy ;
+classes.tuple.private classes.singleton kernel accessors math
+math.intervals namespaces sequences sequences.private words
+combinators memoize combinators.short-circuit byte-arrays
+strings arrays layouts cpu.architecture
+compiler.tree.propagation.copy ;
IN: compiler.tree.propagation.info
: false-class? ( class -- ? ) \ f class<= ;
UNION: fixed-length array byte-array string ;
+: literal-class ( obj -- class )
+ #! Handle forgotten tuples and singleton classes properly
+ dup singleton-class? [
+ class dup class? [
+ drop tuple
+ ] unless
+ ] unless ;
+
: init-literal-info ( info -- info )
empty-interval >>interval
- dup literal>> class >>class
+ dup literal>> literal-class >>class
dup literal>> {
{ [ dup real? ] [ [a,a] >>interval ] }
{ [ dup tuple? ] [ tuple-slot-infos >>slots ] }
] final-info drop
] unit-test
-[ V{ word } ] [
+[ V{ t } ] [
[ { hashtable } declare hashtable instance? ] final-classes
] unit-test
[ { assoc } declare hashtable instance? ] final-classes
] unit-test
-[ V{ word } ] [
+[ V{ t } ] [
[ { string } declare string? ] final-classes
] unit-test
[ { fixnum } declare log2 ] final-classes
] unit-test
-[ V{ word } ] [
+[ V{ t } ] [
[ { fixnum } declare log2 0 >= ] final-classes
] unit-test
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: fry accessors kernel sequences sequences.private assocs
words namespaces classes.algebra combinators
: foldable-call? ( #call word -- ? )
{
- [ nip "foldable" word-prop ]
+ [ nip foldable? ]
[ drop literal-inputs? ]
[ input-classes-match? ]
} 2&& ;
recover ;
: predicate-output-infos/class ( info class -- info )
- [ class>> ] dip {
- { [ 2dup class<= ] [ t <literal-info> ] }
- { [ 2dup classes-intersect? not ] [ f <literal-info> ] }
- [ object-info ]
- } cond 2nip ;
+ [ class>> ] dip compare-classes
+ dup +incomparable+ eq? [ drop object-info ] [ <literal-info> ] if ;
: predicate-output-infos ( info class -- info )
over literal?>>
HELP: lzw-read
{ $values
- { "lzw" lzw }
{ "lzw" lzw } { "n" integer }
}
{ $description "Read the next LZW code." } ;
HELP: reset-lzw-uncompress
{ $values
{ "lzw" lzw }
- { "lzw" lzw }
}
{ $description "Reset the LZW uncompressor state (either at initialization time or immediately after receiving a Clear Code). " } ;
-USING: concurrency.mailboxes concurrency.count-downs concurrency.conditions\r
-vectors sequences threads tools.test math kernel strings namespaces\r
-continuations calendar destructors ;\r
-IN: concurrency.mailboxes.tests\r
-\r
-{ 1 1 } [ [ integer? ] mailbox-get? ] must-infer-as\r
-\r
-[ V{ 1 2 3 } ] [\r
- 0 <vector>\r
- <mailbox>\r
- [ mailbox-get swap push ] in-thread\r
- [ mailbox-get swap push ] in-thread\r
- [ mailbox-get swap push ] in-thread\r
- 1 over mailbox-put\r
- 2 over mailbox-put\r
- 3 swap mailbox-put\r
-] unit-test\r
-\r
-[ V{ 1 2 3 } ] [\r
- 0 <vector>\r
- <mailbox>\r
- [ [ integer? ] mailbox-get? swap push ] in-thread\r
- [ [ integer? ] mailbox-get? swap push ] in-thread\r
- [ [ integer? ] mailbox-get? swap push ] in-thread\r
- 1 over mailbox-put\r
- 2 over mailbox-put\r
- 3 swap mailbox-put\r
-] unit-test\r
-\r
-[ V{ 1 "junk" 3 "junk2" } [ 456 ] ] [\r
- 0 <vector>\r
- <mailbox>\r
- [ [ integer? ] mailbox-get? swap push ] in-thread\r
- [ [ integer? ] mailbox-get? swap push ] in-thread\r
- [ [ string? ] mailbox-get? swap push ] in-thread\r
- [ [ string? ] mailbox-get? swap push ] in-thread\r
- 1 over mailbox-put\r
- "junk" over mailbox-put\r
- [ 456 ] over mailbox-put\r
- 3 over mailbox-put\r
- "junk2" over mailbox-put\r
- mailbox-get\r
-] unit-test\r
-\r
-<mailbox> "m" set\r
-\r
-1 <count-down> "c" set\r
-1 <count-down> "d" set\r
-\r
-[\r
- "c" get await\r
- [ "m" get mailbox-get drop ]\r
- [ drop "d" get count-down ] recover\r
-] "Mailbox close test" spawn drop\r
-\r
-[ ] [ "c" get count-down ] unit-test\r
-[ ] [ "m" get dispose ] unit-test\r
-[ ] [ "d" get 5 seconds await-timeout ] unit-test\r
-\r
-[ ] [ "m" get dispose ] unit-test\r
-\r
-<mailbox> "m" set\r
-\r
-1 <count-down> "c" set\r
-1 <count-down> "d" set\r
-\r
-[\r
- "c" get await\r
- "m" get wait-for-close\r
- "d" get count-down\r
-] "Mailbox close test" spawn drop\r
-\r
-[ ] [ "c" get count-down ] unit-test\r
-[ ] [ "m" get dispose ] unit-test\r
-[ ] [ "d" get 5 seconds await-timeout ] unit-test\r
-\r
-[ ] [ "m" get dispose ] unit-test\r
-\r
-[ { "foo" "bar" } ] [\r
- <mailbox>\r
- "foo" over mailbox-put\r
- "bar" over mailbox-put\r
- mailbox-get-all\r
-] unit-test\r
-\r
-[\r
- <mailbox> 1 seconds mailbox-get-timeout\r
-] [ wait-timeout? ] must-fail-with\r
- \r
+USING: concurrency.mailboxes concurrency.count-downs concurrency.conditions
+vectors sequences threads tools.test math kernel strings namespaces
+continuations calendar destructors ;
+IN: concurrency.mailboxes.tests
+
+{ 1 1 } [ [ integer? ] mailbox-get? ] must-infer-as
+
+[ V{ 1 2 3 } ] [
+ 0 <vector>
+ <mailbox>
+ [ mailbox-get swap push ] in-thread
+ [ mailbox-get swap push ] in-thread
+ [ mailbox-get swap push ] in-thread
+ 1 over mailbox-put
+ 2 over mailbox-put
+ 3 swap mailbox-put
+] unit-test
+
+[ V{ 1 2 3 } ] [
+ 0 <vector>
+ <mailbox>
+ [ [ integer? ] mailbox-get? swap push ] in-thread
+ [ [ integer? ] mailbox-get? swap push ] in-thread
+ [ [ integer? ] mailbox-get? swap push ] in-thread
+ 1 over mailbox-put
+ 2 over mailbox-put
+ 3 swap mailbox-put
+] unit-test
+
+[ V{ 1 "junk" 3 "junk2" } [ 456 ] ] [
+ 0 <vector>
+ <mailbox>
+ [ [ integer? ] mailbox-get? swap push ] in-thread
+ [ [ integer? ] mailbox-get? swap push ] in-thread
+ [ [ string? ] mailbox-get? swap push ] in-thread
+ [ [ string? ] mailbox-get? swap push ] in-thread
+ 1 over mailbox-put
+ "junk" over mailbox-put
+ [ 456 ] over mailbox-put
+ 3 over mailbox-put
+ "junk2" over mailbox-put
+ mailbox-get
+] unit-test
+
+[ { "foo" "bar" } ] [
+ <mailbox>
+ "foo" over mailbox-put
+ "bar" over mailbox-put
+ mailbox-get-all
+] unit-test
+
+[
+ <mailbox> 1 seconds mailbox-get-timeout
+] [ wait-timeout? ] must-fail-with
-! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.\r
-! See http://factorcode.org/license.txt for BSD license.\r
-USING: dlists deques threads sequences continuations\r
-destructors namespaces math quotations words kernel\r
-arrays assocs init system concurrency.conditions accessors\r
-debugger debugger.threads locals fry ;\r
-IN: concurrency.mailboxes\r
-\r
-TUPLE: mailbox < disposable threads data ;\r
-\r
-M: mailbox dispose* threads>> notify-all ;\r
-\r
-: <mailbox> ( -- mailbox )\r
- mailbox new-disposable <dlist> >>threads <dlist> >>data ;\r
-\r
-: mailbox-empty? ( mailbox -- bool )\r
- data>> deque-empty? ;\r
-\r
-: mailbox-put ( obj mailbox -- )\r
- [ data>> push-front ]\r
- [ threads>> notify-all ] bi yield ;\r
-\r
-: wait-for-mailbox ( mailbox timeout -- )\r
- [ threads>> ] dip "mailbox" wait ;\r
-\r
-:: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )\r
- mailbox check-disposed\r
- mailbox data>> pred dlist-any? [\r
- mailbox timeout wait-for-mailbox\r
- mailbox timeout pred block-unless-pred\r
- ] unless ; inline recursive\r
-\r
-: block-if-empty ( mailbox timeout -- mailbox )\r
- over check-disposed\r
- over mailbox-empty? [\r
- 2dup wait-for-mailbox block-if-empty\r
- ] [\r
- drop\r
- ] if ;\r
-\r
-: mailbox-peek ( mailbox -- obj )\r
- data>> peek-back ;\r
-\r
-: mailbox-get-timeout ( mailbox timeout -- obj )\r
- block-if-empty data>> pop-back ;\r
-\r
-: mailbox-get ( mailbox -- obj )\r
- f mailbox-get-timeout ;\r
-\r
-: mailbox-get-all-timeout ( mailbox timeout -- array )\r
- block-if-empty\r
- [ dup mailbox-empty? not ]\r
- [ dup data>> pop-back ]\r
- produce nip ;\r
-\r
-: mailbox-get-all ( mailbox -- array )\r
- f mailbox-get-all-timeout ;\r
-\r
-: while-mailbox-empty ( mailbox quot -- )\r
- [ '[ _ mailbox-empty? ] ] dip while ; inline\r
-\r
-: mailbox-get-timeout? ( mailbox timeout pred -- obj )\r
- [ block-unless-pred ]\r
- [ [ drop data>> ] dip delete-node-if ]\r
- 3bi ; inline\r
-\r
-: mailbox-get? ( mailbox pred -- obj )\r
- f swap mailbox-get-timeout? ; inline\r
-\r
-: wait-for-close-timeout ( mailbox timeout -- )\r
- over disposed>>\r
- [ 2drop ] [ 2dup wait-for-mailbox wait-for-close-timeout ] if ;\r
-\r
-: wait-for-close ( mailbox -- )\r
- f wait-for-close-timeout ;\r
-\r
-TUPLE: linked-error error thread ;\r
-\r
-M: linked-error error.\r
- [ thread>> error-in-thread. ] [ error>> error. ] bi ;\r
-\r
-C: <linked-error> linked-error\r
-\r
-: ?linked ( message -- message )\r
- dup linked-error? [ rethrow ] when ;\r
-\r
-TUPLE: linked-thread < thread supervisor ;\r
-\r
-M: linked-thread error-in-thread\r
- [ <linked-error> ] [ supervisor>> ] bi mailbox-put ;\r
-\r
-: <linked-thread> ( quot name mailbox -- thread' )\r
- [ linked-thread new-thread ] dip >>supervisor ;\r
-\r
-: spawn-linked-to ( quot name mailbox -- thread )\r
- <linked-thread> [ (spawn) ] keep ;\r
+! Copyright (C) 2005, 2010 Chris Double, Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: dlists deques threads sequences continuations namespaces
+math quotations words kernel arrays assocs init system
+concurrency.conditions accessors debugger debugger.threads
+locals fry ;
+IN: concurrency.mailboxes
+
+TUPLE: mailbox threads data ;
+
+: <mailbox> ( -- mailbox )
+ mailbox new
+ <dlist> >>threads
+ <dlist> >>data ;
+
+: mailbox-empty? ( mailbox -- bool )
+ data>> deque-empty? ;
+
+: mailbox-put ( obj mailbox -- )
+ [ data>> push-front ]
+ [ threads>> notify-all ] bi yield ;
+
+: wait-for-mailbox ( mailbox timeout -- )
+ [ threads>> ] dip "mailbox" wait ;
+
+:: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )
+ mailbox data>> pred dlist-any? [
+ mailbox timeout wait-for-mailbox
+ mailbox timeout pred block-unless-pred
+ ] unless ; inline recursive
+
+: block-if-empty ( mailbox timeout -- mailbox )
+ over mailbox-empty? [
+ 2dup wait-for-mailbox block-if-empty
+ ] [
+ drop
+ ] if ;
+
+: mailbox-peek ( mailbox -- obj )
+ data>> peek-back ;
+
+: mailbox-get-timeout ( mailbox timeout -- obj )
+ block-if-empty data>> pop-back ;
+
+: mailbox-get ( mailbox -- obj )
+ f mailbox-get-timeout ;
+
+: mailbox-get-all-timeout ( mailbox timeout -- array )
+ block-if-empty
+ [ dup mailbox-empty? not ]
+ [ dup data>> pop-back ]
+ produce nip ;
+
+: mailbox-get-all ( mailbox -- array )
+ f mailbox-get-all-timeout ;
+
+: while-mailbox-empty ( mailbox quot -- )
+ [ '[ _ mailbox-empty? ] ] dip while ; inline
+
+: mailbox-get-timeout? ( mailbox timeout pred -- obj )
+ [ block-unless-pred ]
+ [ [ drop data>> ] dip delete-node-if ]
+ 3bi ; inline
+
+: mailbox-get? ( mailbox pred -- obj )
+ f swap mailbox-get-timeout? ; inline
+
+: wait-for-close-timeout ( mailbox timeout -- )
+ over disposed>>
+ [ 2drop ] [ 2dup wait-for-mailbox wait-for-close-timeout ] if ;
+
+: wait-for-close ( mailbox -- )
+ f wait-for-close-timeout ;
+
+TUPLE: linked-error error thread ;
+
+M: linked-error error.
+ [ thread>> error-in-thread. ] [ error>> error. ] bi ;
+
+C: <linked-error> linked-error
+
+: ?linked ( message -- message )
+ dup linked-error? [ rethrow ] when ;
+
+TUPLE: linked-thread < thread supervisor ;
+
+M: linked-thread error-in-thread
+ [ <linked-error> ] [ supervisor>> ] bi mailbox-put ;
+
+: <linked-thread> ( quot name mailbox -- thread' )
+ [ linked-thread new-thread ] dip >>supervisor ;
+
+: spawn-linked-to ( quot name mailbox -- thread )
+ <linked-thread> [ (spawn) ] keep ;
-! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.\r
-! See http://factorcode.org/license.txt for BSD license.\r
-USING: accessors concurrency.mailboxes kernel continuations ;\r
-IN: concurrency.promises\r
-\r
-TUPLE: promise mailbox ;\r
-\r
-: <promise> ( -- promise )\r
- <mailbox> promise boa ;\r
-\r
-: promise-fulfilled? ( promise -- ? )\r
- mailbox>> mailbox-empty? not ;\r
-\r
-ERROR: promise-already-fulfilled promise ;\r
-: fulfill ( value promise -- )\r
- dup promise-fulfilled? [ \r
- promise-already-fulfilled\r
- ] [\r
- mailbox>> mailbox-put\r
- ] if ;\r
-\r
-: ?promise-timeout ( promise timeout -- result )\r
- [ mailbox>> ] dip block-if-empty mailbox-peek ;\r
-\r
-: ?promise ( promise -- result )\r
- f ?promise-timeout ;\r
+! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors concurrency.mailboxes kernel continuations ;
+IN: concurrency.promises
+
+TUPLE: promise mailbox ;
+
+: <promise> ( -- promise )
+ <mailbox> promise boa ;
+
+: promise-fulfilled? ( promise -- ? )
+ mailbox>> mailbox-empty? not ;
+
+ERROR: promise-already-fulfilled promise ;
+
+: fulfill ( value promise -- )
+ dup promise-fulfilled? [
+ promise-already-fulfilled
+ ] [
+ mailbox>> mailbox-put
+ ] if ;
+
+: ?promise-timeout ( promise timeout -- result )
+ [ mailbox>> ] dip block-if-empty mailbox-peek ;
+
+: ?promise ( promise -- result )
+ f ?promise-timeout ;
CONSTANT: kCFPropertyListMutableContainers 1
CONSTANT: kCFPropertyListMutableContainersAndLeaves 2
-FUNCTION: CFDataRef CFDataCreate ( CFAllocatorRef allocator, uchar* bytes, CFIndex length ) ;
+FUNCTION: CFDataRef CFDataCreate ( CFAllocatorRef allocator, UInt8* bytes, CFIndex length ) ;
FUNCTION: CFTypeID CFGetTypeID ( CFTypeRef cf ) ;
{ release void* }
{ copyDescription void* } ;
-! callback(
CALLBACK: void FSEventStreamCallback ( FSEventStreamRef streamRef, void* clientCallBackInfo, size_t numEvents, void* eventPaths, FSEventStreamEventFlags* eventFlags, FSEventStreamEventId* eventIds ) ;
CONSTANT: FSEventStreamEventIdSinceNow HEX: FFFFFFFFFFFFFFFF
info event-stream-callbacks get at [ drop ] or call( changes -- ) ;
: master-event-source-callback ( -- alien )
- "void"
- {
- "FSEventStreamRef"
- "void*" ! info
- "size_t" ! numEvents
- "void*" ! eventPaths
- "FSEventStreamEventFlags*"
- "FSEventStreamEventId*"
- }
- "cdecl" [ (master-event-source-callback) ] alien-callback ;
+ [ (master-event-source-callback) ] FSEventStreamCallback ;
TUPLE: event-stream < disposable info handle ;
+++ /dev/null
-unportable
+++ /dev/null
-unportable
-! Copyright (C) 2008 Slava Pestov
+! Copyright (C) 2008, 2010 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.syntax kernel math
namespaces sequences destructors combinators threads heaps
CFRunLoopAddTimer
] bi ;
+: invalidate-run-loop-timers ( -- )
+ run-loop [
+ [ [ CFRunLoopTimerInvalidate ] [ CFRelease ] bi ] each
+ V{ } clone
+ ] change-timers drop ;
+
<PRIVATE
: ((reset-timer)) ( timer counter timestamp -- )
+++ /dev/null
-unportable
FUNCTION: Boolean CFStringGetCString (
CFStringRef theString,
- char* buffer,
+ UInt8* buffer,
CFIndex bufferSize,
CFStringEncoding encoding
) ;
FUNCTION: CFStringRef CFStringCreateWithCString (
CFAllocatorRef alloc,
- char* cStr,
+ UInt8* cStr,
CFStringEncoding encoding
) ;
+++ /dev/null
-unportable
+++ /dev/null
-unportable
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs sequences kernel combinators make math
math.order math.ranges system namespaces locals layouts words
-alien alien.accessors alien.c-types alien.data literals cpu.architecture
-cpu.ppc.assembler cpu.ppc.assembler.backend compiler.cfg.registers
+alien alien.accessors alien.c-types alien.complex alien.data
+literals cpu.architecture cpu.ppc.assembler
+cpu.ppc.assembler.backend compiler.cfg.registers
compiler.cfg.instructions compiler.cfg.comparisons
compiler.codegen.fixup compiler.cfg.intrinsics
compiler.cfg.stack-frame compiler.cfg.build-stack-frame
{ [ os linux? ] [ "cpu.ppc.linux" require ] }
} cond
-"complex-double" c-type t >>return-in-registers? drop
+complex-double c-type t >>return-in-registers? drop
-unportable
compiler
+untested
-unportable
+untested
compiler
-unportable
+untested
compiler
+++ /dev/null
-unportable
-unportable
+untested
compiler
C-TYPE: PGresult
C-TYPE: PGcancel
TYPEDEF: uint Oid
-TYPEDEF: uint* Oid*
TYPEDEF: char pqbool
C-TYPE: PQconninfoOption
C-TYPE: PGnotify
! make a new client connection to the backend
! Asynchronous (non-blocking)
-FUNCTION: PGconn* PQconnectStart ( char* conninfo ) ;
+FUNCTION: PGconn* PQconnectStart ( c-string conninfo ) ;
FUNCTION: PostgresPollingStatusType PQconnectPoll ( PGconn* conn ) ;
! Synchronous (blocking)
-FUNCTION: PGconn* PQconnectdb ( char* conninfo ) ;
-FUNCTION: PGconn* PQsetdbLogin ( char* pghost, char* pgport,
- char* pgoptions, char* pgtty,
- char* dbName,
- char* login, char* pwd ) ;
+FUNCTION: PGconn* PQconnectdb ( c-string conninfo ) ;
+FUNCTION: PGconn* PQsetdbLogin ( c-string pghost, c-string pgport,
+ c-string pgoptions, c-string pgtty,
+ c-string dbName,
+ c-string login, c-string pwd ) ;
: PQsetdb ( M_PGHOST M_PGPORT M_PGOPT M_PGTTY M_DBNAME -- PGconn* )
f f PQsetdbLogin ;
FUNCTION: int PQrequestCancel ( PGconn* conn ) ;
! Accessor functions for PGconn objects
-FUNCTION: char* PQdb ( PGconn* conn ) ;
-FUNCTION: char* PQuser ( PGconn* conn ) ;
-FUNCTION: char* PQpass ( PGconn* conn ) ;
-FUNCTION: char* PQhost ( PGconn* conn ) ;
-FUNCTION: char* PQport ( PGconn* conn ) ;
-FUNCTION: char* PQtty ( PGconn* conn ) ;
-FUNCTION: char* PQoptions ( PGconn* conn ) ;
+FUNCTION: c-string PQdb ( PGconn* conn ) ;
+FUNCTION: c-string PQuser ( PGconn* conn ) ;
+FUNCTION: c-string PQpass ( PGconn* conn ) ;
+FUNCTION: c-string PQhost ( PGconn* conn ) ;
+FUNCTION: c-string PQport ( PGconn* conn ) ;
+FUNCTION: c-string PQtty ( PGconn* conn ) ;
+FUNCTION: c-string PQoptions ( PGconn* conn ) ;
FUNCTION: ConnStatusType PQstatus ( PGconn* conn ) ;
FUNCTION: PGTransactionStatusType PQtransactionStatus ( PGconn* conn ) ;
-FUNCTION: char* PQparameterStatus ( PGconn* conn,
- char* paramName ) ;
+FUNCTION: c-string PQparameterStatus ( PGconn* conn,
+ c-string paramName ) ;
FUNCTION: int PQprotocolVersion ( PGconn* conn ) ;
! FUNCTION: int PQServerVersion ( PGconn* conn ) ;
-FUNCTION: char* PQerrorMessage ( PGconn* conn ) ;
+FUNCTION: c-string PQerrorMessage ( PGconn* conn ) ;
FUNCTION: int PQsocket ( PGconn* conn ) ;
FUNCTION: int PQbackendPID ( PGconn* conn ) ;
FUNCTION: int PQclientEncoding ( PGconn* conn ) ;
-FUNCTION: int PQsetClientEncoding ( PGconn* conn, char* encoding ) ;
+FUNCTION: int PQsetClientEncoding ( PGconn* conn, c-string encoding ) ;
! May not be compiled into libpq
! Get the SSL structure associated with a connection
! BROKEN
! Function types for notice-handling callbacks
! typedef void (*PQnoticeReceiver) (void *arg, PGresult *res);
-! typedef void (*PQnoticeProcessor) (void *arg, char* message);
+! typedef void (*PQnoticeProcessor) (void *arg, c-string message);
! ALIAS: void* PQnoticeReceiver
! ALIAS: void* PQnoticeProcessor
! === in fe-exec.c ===
! Simple synchronous query
-FUNCTION: PGresult* PQexec ( PGconn* conn, char* query ) ;
+FUNCTION: PGresult* PQexec ( PGconn* conn, c-string query ) ;
FUNCTION: PGresult* PQexecParams ( PGconn* conn,
- char* command,
+ c-string command,
int nParams,
Oid* paramTypes,
- char** paramValues,
+ c-string* paramValues,
int* paramLengths,
int* paramFormats,
int resultFormat ) ;
-FUNCTION: PGresult* PQprepare ( PGconn* conn, char* stmtName,
- char* query, int nParams,
+FUNCTION: PGresult* PQprepare ( PGconn* conn, c-string stmtName,
+ c-string query, int nParams,
Oid* paramTypes ) ;
FUNCTION: PGresult* PQexecPrepared ( PGconn* conn,
- char* stmtName,
+ c-string stmtName,
int nParams,
- char** paramValues,
+ c-string* paramValues,
int* paramLengths,
int* paramFormats,
int resultFormat ) ;
! Interface for multiple-result or asynchronous queries
-FUNCTION: int PQsendQuery ( PGconn* conn, char* query ) ;
+FUNCTION: int PQsendQuery ( PGconn* conn, c-string query ) ;
FUNCTION: int PQsendQueryParams ( PGconn* conn,
- char* command,
+ c-string command,
int nParams,
Oid* paramTypes,
- char** paramValues,
+ c-string* paramValues,
int* paramLengths,
int* paramFormats,
int resultFormat ) ;
-FUNCTION: PGresult* PQsendPrepare ( PGconn* conn, char* stmtName,
- char* query, int nParams,
+FUNCTION: PGresult* PQsendPrepare ( PGconn* conn, c-string stmtName,
+ c-string query, int nParams,
Oid* paramTypes ) ;
FUNCTION: int PQsendQueryPrepared ( PGconn* conn,
- char* stmtName,
+ c-string stmtName,
int nParams,
- char** paramValues,
+ c-string* paramValues,
int *paramLengths,
int *paramFormats,
int resultFormat ) ;
FUNCTION: PGnotify* PQnotifies ( PGconn* conn ) ;
! Routines for copy in/out
-FUNCTION: int PQputCopyData ( PGconn* conn, char* buffer, int nbytes ) ;
-FUNCTION: int PQputCopyEnd ( PGconn* conn, char* errormsg ) ;
-FUNCTION: int PQgetCopyData ( PGconn* conn, char** buffer, int async ) ;
+FUNCTION: int PQputCopyData ( PGconn* conn, c-string buffer, int nbytes ) ;
+FUNCTION: int PQputCopyEnd ( PGconn* conn, c-string errormsg ) ;
+FUNCTION: int PQgetCopyData ( PGconn* conn, c-string* buffer, int async ) ;
! Deprecated routines for copy in/out
-FUNCTION: int PQgetline ( PGconn* conn, char* string, int length ) ;
-FUNCTION: int PQputline ( PGconn* conn, char* string ) ;
-FUNCTION: int PQgetlineAsync ( PGconn* conn, char* buffer, int bufsize ) ;
-FUNCTION: int PQputnbytes ( PGconn* conn, char* buffer, int nbytes ) ;
+FUNCTION: int PQgetline ( PGconn* conn, c-string string, int length ) ;
+FUNCTION: int PQputline ( PGconn* conn, c-string string ) ;
+FUNCTION: int PQgetlineAsync ( PGconn* conn, c-string buffer, int bufsize ) ;
+FUNCTION: int PQputnbytes ( PGconn* conn, c-string buffer, int nbytes ) ;
FUNCTION: int PQendcopy ( PGconn* conn ) ;
! Set blocking/nonblocking connection to the backend
! Accessor functions for PGresult objects
FUNCTION: ExecStatusType PQresultStatus ( PGresult* res ) ;
-FUNCTION: char* PQresStatus ( ExecStatusType status ) ;
-FUNCTION: char* PQresultErrorMessage ( PGresult* res ) ;
-FUNCTION: char* PQresultErrorField ( PGresult* res, int fieldcode ) ;
+FUNCTION: c-string PQresStatus ( ExecStatusType status ) ;
+FUNCTION: c-string PQresultErrorMessage ( PGresult* res ) ;
+FUNCTION: c-string PQresultErrorField ( PGresult* res, int fieldcode ) ;
FUNCTION: int PQntuples ( PGresult* res ) ;
FUNCTION: int PQnfields ( PGresult* res ) ;
FUNCTION: int PQbinaryTuples ( PGresult* res ) ;
-FUNCTION: char* PQfname ( PGresult* res, int field_num ) ;
-FUNCTION: int PQfnumber ( PGresult* res, char* field_name ) ;
+FUNCTION: c-string PQfname ( PGresult* res, int field_num ) ;
+FUNCTION: int PQfnumber ( PGresult* res, c-string field_name ) ;
FUNCTION: Oid PQftable ( PGresult* res, int field_num ) ;
FUNCTION: int PQftablecol ( PGresult* res, int field_num ) ;
FUNCTION: int PQfformat ( PGresult* res, int field_num ) ;
FUNCTION: Oid PQftype ( PGresult* res, int field_num ) ;
FUNCTION: int PQfsize ( PGresult* res, int field_num ) ;
FUNCTION: int PQfmod ( PGresult* res, int field_num ) ;
-FUNCTION: char* PQcmdStatus ( PGresult* res ) ;
-FUNCTION: char* PQoidStatus ( PGresult* res ) ;
+FUNCTION: c-string PQcmdStatus ( PGresult* res ) ;
+FUNCTION: c-string PQoidStatus ( PGresult* res ) ;
FUNCTION: Oid PQoidValue ( PGresult* res ) ;
-FUNCTION: char* PQcmdTuples ( PGresult* res ) ;
-! FUNCTION: char* PQgetvalue ( PGresult* res, int tup_num, int field_num ) ;
+FUNCTION: c-string PQcmdTuples ( PGresult* res ) ;
+! FUNCTION: c-string PQgetvalue ( PGresult* res, int tup_num, int field_num ) ;
FUNCTION: void* PQgetvalue ( PGresult* res, int tup_num, int field_num ) ;
FUNCTION: int PQgetlength ( PGresult* res, int tup_num, int field_num ) ;
FUNCTION: int PQgetisnull ( PGresult* res, int tup_num, int field_num ) ;
! Quoting strings before inclusion in queries.
FUNCTION: size_t PQescapeStringConn ( PGconn* conn,
- char* to, char* from, size_t length,
+ c-string to, c-string from, size_t length,
int* error ) ;
-FUNCTION: uchar* PQescapeByteaConn ( PGconn* conn,
- char* from, size_t length,
+FUNCTION: c-string PQescapeByteaConn ( PGconn* conn,
+ c-string from, size_t length,
size_t* to_length ) ;
-FUNCTION: void* PQunescapeBytea ( uchar* strtext, size_t* retbuflen ) ;
-! FUNCTION: uchar* PQunescapeBytea ( uchar* strtext, size_t* retbuflen ) ;
+FUNCTION: void* PQunescapeBytea ( c-string strtext, size_t* retbuflen ) ;
+! FUNCTION: c-string PQunescapeBytea ( c-string strtext, size_t* retbuflen ) ;
! These forms are deprecated!
-FUNCTION: size_t PQescapeString ( void* to, char* from, size_t length ) ;
-FUNCTION: uchar* PQescapeBytea ( uchar* bintext, size_t binlen,
+FUNCTION: size_t PQescapeString ( void* to, c-string from, size_t length ) ;
+FUNCTION: c-string PQescapeBytea ( c-string bintext, size_t binlen,
size_t* bytealen ) ;
! === in fe-print.c ===
FUNCTION: void PQdisplayTuples ( PGresult* res,
FILE* fp,
int fillAlign,
- char* fieldSep,
+ c-string fieldSep,
int printHeader,
int quiet ) ;
! Large-object access routines
FUNCTION: int lo_open ( PGconn* conn, Oid lobjId, int mode ) ;
FUNCTION: int lo_close ( PGconn* conn, int fd ) ;
-FUNCTION: int lo_read ( PGconn* conn, int fd, char* buf, size_t len ) ;
-FUNCTION: int lo_write ( PGconn* conn, int fd, char* buf, size_t len ) ;
+FUNCTION: int lo_read ( PGconn* conn, int fd, c-string buf, size_t len ) ;
+FUNCTION: int lo_write ( PGconn* conn, int fd, c-string buf, size_t len ) ;
FUNCTION: int lo_lseek ( PGconn* conn, int fd, int offset, int whence ) ;
FUNCTION: Oid lo_creat ( PGconn* conn, int mode ) ;
! FUNCTION: Oid lo_creat ( PGconn* conn, Oid lobjId ) ;
FUNCTION: int lo_tell ( PGconn* conn, int fd ) ;
FUNCTION: int lo_unlink ( PGconn* conn, Oid lobjId ) ;
-FUNCTION: Oid lo_import ( PGconn* conn, char* filename ) ;
-FUNCTION: int lo_export ( PGconn* conn, Oid lobjId, char* filename ) ;
+FUNCTION: Oid lo_import ( PGconn* conn, c-string filename ) ;
+FUNCTION: int lo_export ( PGconn* conn, Oid lobjId, c-string filename ) ;
! === in fe-misc.c ===
! Determine length of multibyte encoded char at *s
-FUNCTION: int PQmblen ( uchar* s, int encoding ) ;
+FUNCTION: int PQmblen ( c-string s, int encoding ) ;
! Determine display length of multibyte encoded char at *s
-FUNCTION: int PQdsplen ( uchar* s, int encoding ) ;
+FUNCTION: int PQdsplen ( c-string s, int encoding ) ;
! Get encoding id from environment variable PGCLIENTENCODING
FUNCTION: int PQenv2encoding ( ) ;
CONSTANT: SQLITE_OPEN_SUBJOURNAL HEX: 00002000
CONSTANT: SQLITE_OPEN_MASTER_JOURNAL HEX: 00004000
-TYPEDEF: void* sqlite3*
-TYPEDEF: void* sqlite3_stmt*
+C-TYPE: sqlite3
+C-TYPE: sqlite3_stmt
TYPEDEF: longlong sqlite3_int64
TYPEDEF: ulonglong sqlite3_uint64
LIBRARY: sqlite
-FUNCTION: int sqlite3_open ( char* filename, void* ppDb ) ;
+FUNCTION: int sqlite3_open ( c-string filename, void* ppDb ) ;
FUNCTION: int sqlite3_close ( sqlite3* pDb ) ;
-FUNCTION: char* sqlite3_errmsg ( sqlite3* pDb ) ;
-FUNCTION: int sqlite3_prepare ( sqlite3* pDb, char* zSql, int nBytes, void* ppStmt, void* pzTail ) ;
-FUNCTION: int sqlite3_prepare_v2 ( sqlite3* pDb, char* zSql, int nBytes, void* ppStmt, void* pzTail ) ;
+FUNCTION: c-string sqlite3_errmsg ( sqlite3* pDb ) ;
+FUNCTION: int sqlite3_prepare ( sqlite3* pDb, c-string zSql, int nBytes, void* ppStmt, void* pzTail ) ;
+FUNCTION: int sqlite3_prepare_v2 ( sqlite3* pDb, c-string zSql, int nBytes, void* ppStmt, void* pzTail ) ;
FUNCTION: int sqlite3_finalize ( sqlite3_stmt* pStmt ) ;
FUNCTION: int sqlite3_reset ( sqlite3_stmt* pStmt ) ;
FUNCTION: int sqlite3_step ( sqlite3_stmt* pStmt ) ;
! Bind the same function as above, but for unsigned 64bit integers
: sqlite3-bind-uint64 ( pStmt index in64 -- int )
int "sqlite" "sqlite3_bind_int64"
- { sqlite3_stmt* int sqlite3_uint64 } alien-invoke ;
+ { pointer: sqlite3_stmt int sqlite3_uint64 } alien-invoke ;
FUNCTION: int sqlite3_bind_null ( sqlite3_stmt* pStmt, int n ) ;
-FUNCTION: int sqlite3_bind_text ( sqlite3_stmt* pStmt, int index, char* text, int len, int destructor ) ;
-FUNCTION: int sqlite3_bind_parameter_index ( sqlite3_stmt* pStmt, char* name ) ;
+FUNCTION: int sqlite3_bind_text ( sqlite3_stmt* pStmt, int index, c-string text, int len, int destructor ) ;
+FUNCTION: int sqlite3_bind_parameter_index ( sqlite3_stmt* pStmt, c-string name ) ;
FUNCTION: int sqlite3_clear_bindings ( sqlite3_stmt* pStmt ) ;
FUNCTION: int sqlite3_column_count ( sqlite3_stmt* pStmt ) ;
FUNCTION: void* sqlite3_column_blob ( sqlite3_stmt* pStmt, int col ) ;
FUNCTION: int sqlite3_column_bytes ( sqlite3_stmt* pStmt, int col ) ;
-FUNCTION: char* sqlite3_column_decltype ( sqlite3_stmt* pStmt, int col ) ;
+FUNCTION: c-string sqlite3_column_decltype ( sqlite3_stmt* pStmt, int col ) ;
FUNCTION: int sqlite3_column_int ( sqlite3_stmt* pStmt, int col ) ;
FUNCTION: sqlite3_int64 sqlite3_column_int64 ( sqlite3_stmt* pStmt, int col ) ;
! Bind the same function as above, but for unsigned 64bit integers
: sqlite3-column-uint64 ( pStmt col -- uint64 )
sqlite3_uint64 "sqlite" "sqlite3_column_int64"
- { sqlite3_stmt* int } alien-invoke ;
+ { pointer: sqlite3_stmt int } alien-invoke ;
FUNCTION: double sqlite3_column_double ( sqlite3_stmt* pStmt, int col ) ;
-FUNCTION: char* sqlite3_column_name ( sqlite3_stmt* pStmt, int col ) ;
-FUNCTION: char* sqlite3_column_text ( sqlite3_stmt* pStmt, int col ) ;
+FUNCTION: c-string sqlite3_column_name ( sqlite3_stmt* pStmt, int col ) ;
+FUNCTION: c-string sqlite3_column_text ( sqlite3_stmt* pStmt, int col ) ;
FUNCTION: int sqlite3_column_type ( sqlite3_stmt* pStmt, int col ) ;
HELP: <select-by-slots-statement>
{ $values
{ "tuple" tuple } { "class" class }
- { "tuple" tuple } }
+ { "statement" tuple } }
{ $description "A database-specific hook for generating the SQL for a select statement." } ;
HELP: <update-tuple-statement>
{ $list
"Make a new tuple to represent your data"
{ "Map the Factor types to the database types with " { $link define-persistent } }
- { "Make a custom database combinator (see" { $link "db-custom-database-combinators" } ") to open your database and run a " { $link quotation } }
+ { "Make a custom database combinator (see " { $link "db-custom-database-combinators" } ") to open your database and run a " { $link quotation } }
{ "Create a table with " { $link create-table } ", " { $link ensure-table } ", or " { $link recreate-table } }
{ "Start making and storing objects with " { $link insert-tuple } ", " { $link update-tuple } ", " { $link delete-tuples } ", and " { $link select-tuples } }
} ;
HOOK: <insert-user-assigned-statement> db-connection ( class -- object )
HOOK: <update-tuple-statement> db-connection ( class -- object )
HOOK: <delete-tuples-statement> db-connection ( tuple class -- object )
-HOOK: <select-by-slots-statement> db-connection ( tuple class -- tuple )
+HOOK: <select-by-slots-statement> db-connection ( tuple class -- statement )
HOOK: <count-statement> db-connection ( query -- statement )
HOOK: query>statement db-connection ( query -- statement )
HOOK: insert-tuple-set-key db-connection ( tuple statement -- )
drop "Not a tuple" ;
M: bad-superclass summary
- drop "Tuple classes can only inherit from other tuple classes" ;
+ drop "Tuple classes can only inherit from non-final tuple classes" ;
M: no-initial-value summary
drop "Initial value must be provided for slots specialized to this class" ;
+++ /dev/null
-unportable
! Protocols
<PRIVATE
-: cross-2each ( seq1 seq2 quot -- )
- [ with each ] 2curry each ; inline
-
: forget-all-methods ( classes words -- )
- [ first method forget ] cross-2each ;
+ [ first method forget ] cartesian-each ;
: protocol-users ( protocol -- users )
protocol-consult keys ;
: add-new-definitions ( protocol wordlist -- )
[ drop protocol-consult values ] [ added-words ] 2bi
- [ swap consult-method ] cross-2each ;
+ [ swap consult-method ] cartesian-each ;
: initialize-protocol-props ( protocol wordlist -- )
[
} ;
HELP: dlist-filter
-{ $values { "dlist" { $link dlist } } { "quot" quotation } { "dlist" { $link dlist } } }
+{ $values { "dlist" { $link dlist } } { "quot" quotation } { "dlist'" { $link dlist } } }
{ $description "Applies the quotation to each element of the " { $link dlist } " in turn, removing the corresponding nodes if the quotation returns " { $link f } "." }
{ $side-effects { "dlist" } } ;
: 1dlist ( obj -- dlist ) <dlist> [ push-front ] keep ;
-: dlist-filter ( dlist quot -- dlist )
+: dlist-filter ( dlist quot -- dlist' )
over [ '[ dup obj>> @ [ drop ] [ _ delete-node ] if ] dlist-each-node ] keep ; inline
M: dlist clone
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
"For example:\n"
{ $list
"\"%5s\" formats a string padding with spaces up to 5 characters wide."
- "\"%08d\" formats an integer padding with zeros up to 3 characters wide."
+ "\"%03d\" formats an integer padding with zeros up to 3 characters wide."
"\"%'#5f\" formats a float padding with '#' up to 3 characters wide."
"\"%-10d\" formats an integer to 10 characters wide and left-aligns."
}
[ ] [ compose ] reduce ;
: fix-sign ( string -- string )
- dup CHAR: 0 swap index 0 =
+ dup CHAR: 0 swap index 0 =
[ dup 0 swap [ [ CHAR: 0 = not ] keep digit? and ] find-from
[ dup 1 - rot dup [ nth ] dip swap
{
{ CHAR: - [ [ 1 - ] dip remove-nth "-" prepend ] }
{ CHAR: + [ [ 1 - ] dip remove-nth "+" prepend ] }
- [ drop swap drop ]
- } case
+ [ drop swap drop ]
+ } case
] [ drop ] if
] when ;
-: >digits ( string -- digits )
+: >digits ( string -- digits )
[ 0 ] [ string>number ] if-empty ;
: pad-digits ( string digits -- string' )
10^ [ * round ] keep / ; inline
: >exp ( x -- exp base )
- [
+ [
abs 0 swap
[ dup [ 10.0 >= ] [ 1.0 < ] bi or ]
[ dup 10.0 >=
[ 10.0 / [ 1 + ] dip ]
[ 10.0 * [ 1 - ] dip ] if
- ] while
+ ] while
] keep 0 < [ neg ] when ;
: exp>string ( exp base digits -- string )
[ max-digits ] keep -rot
[
[ 0 < "-" "+" ? ]
- [ abs number>string 2 CHAR: 0 pad-head ] bi
+ [ abs number>string 2 CHAR: 0 pad-head ] bi
"e" -rot 3append
]
[ number>string ] bi*
char = "'" (.) => [[ second ]]
pad-char = (zero|char)? => [[ CHAR: \s or ]]
-pad-align = ("-")? => [[ \ pad-tail \ pad-head ? ]]
+pad-align = ("-")? => [[ \ pad-tail \ pad-head ? ]]
pad-width = ([0-9])* => [[ >digits ]]
pad = pad-align pad-char pad-width => [[ reverse >quotation dup first 0 = [ drop [ ] ] when ]]
sign = ("+")? => [[ [ dup CHAR: - swap index [ "+" prepend ] unless ] [ ] ? ]]
width_ = "." ([0-9])* => [[ second >digits '[ _ short head ] ]]
-width = (width_)? => [[ [ ] or ]]
+width = (width_)? => [[ [ ] or ]]
digits_ = "." ([0-9])* => [[ second >digits ]]
digits = (digits_)? => [[ 6 or ]]
-fmt-% = "%" => [[ [ "%" ] ]]
+fmt-% = "%" => [[ [ "%" ] ]]
fmt-c = "c" => [[ [ 1string ] ]]
fmt-C = "C" => [[ [ 1string >upper ] ]]
fmt-s = "s" => [[ [ dup number? [ number>string ] when ] ]]
fmt-d = "d" => [[ [ >fixnum number>string ] ]]
fmt-e = digits "e" => [[ first '[ >exp _ exp>string ] ]]
fmt-E = digits "E" => [[ first '[ >exp _ exp>string >upper ] ]]
-fmt-f = digits "f" => [[ first dup '[ >float _ max-digits number>string _ pad-digits ] ]]
+fmt-f = digits "f" => [[ first dup '[ >float _ max-digits number>string _ pad-digits ] ]]
fmt-x = "x" => [[ [ >hex ] ]]
fmt-X = "X" => [[ [ >hex >upper ] ]]
unknown = (.)* => [[ "Unknown directive" throw ]]
numbers_ = fmt-d|fmt-e|fmt-E|fmt-f|fmt-x|fmt-X
numbers = sign pad numbers_ => [[ unclip-last prefix compose-all [ fix-sign ] append ]]
-types = strings|numbers
+types = strings|numbers
-lists = "[%" types ", %]" => [[ second '[ _ map ", " join "{ " prepend " }" append ] ]]
+lists = "[%" types ", %]" => [[ second '[ _ map ", " join "{ " prepend " }" append ] ]]
assocs = "[%" types ": %" types " %]" => [[ [ second ] [ fourth ] bi '[ unzip [ _ map ] dip _ map zip [ ":" join ] map ", " join "{ " prepend " }" append ] ]]
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs byte-arrays calendar classes
-combinators combinators.short-circuit concurrency.promises
-continuations destructors ftp io io.backend io.directories
-io.encodings io.encodings.binary
-tools.files io.encodings.utf8 io.files io.files.info
-io.pathnames io.launcher.unix.parser io.servers.connection
-io.sockets io.streams.duplex io.streams.string io.timeouts
-kernel make math math.bitwise math.parser namespaces sequences
-splitting threads unicode.case logging calendar.format
-strings io.files.links io.files.types io.encodings.8-bit.latin1 ;
+USING: accessors assocs byte-arrays calendar classes combinators
+combinators.short-circuit concurrency.promises continuations
+destructors ftp io io.backend io.directories io.encodings
+io.encodings.binary tools.files io.encodings.utf8 io.files
+io.files.info io.pathnames io.servers.connection io.sockets
+io.streams.duplex io.streams.string io.timeouts kernel make math
+math.bitwise math.parser namespaces sequences splitting threads
+unicode.case logging calendar.format strings io.files.links
+io.files.types io.encodings.8-bit.latin1 simple-tokenizer ;
IN: ftp.server
SYMBOL: server
dup \ <ftp-command> DEBUG log-message
ftp-command new
over >>raw
- swap tokenize-command >>tokenized ;
+ swap tokenize >>tokenized ;
TUPLE: ftp-get path ;
: <ftp-get> ( path -- obj )
USING: accessors arrays assocs generic.standard kernel
lexer locals.types namespaces parser quotations vocabs.parser
-words ;
+words classes.tuple ;
IN: functors.backend
DEFER: functor-words
: define* ( word def -- ) over set-word define ;
-: define-declared* ( word def effect -- ) pick set-word define-declared ;
+: define-declared* ( word def effect -- )
+ pick set-word define-declared ;
-: define-simple-generic* ( word effect -- ) over set-word define-simple-generic ;
+: define-simple-generic* ( word effect -- )
+ over set-word define-simple-generic ;
+: define-tuple-class* ( class superclass slots -- )
+ pick set-word define-tuple-class ;
-USING: classes.struct functors tools.test math words kernel
-multiline parser io.streams.string generic ;
+USING: classes.struct classes.tuple functors tools.test math
+words kernel multiline parser io.streams.string generic ;
QUALIFIED-WITH: alien.c-types c
IN: functors.tests
WHERE
-: WW ( a -- b ) \ W twice ; inline
+: WW ( a -- b ) \ W twice ;
;FUNCTOR
}
] [ a-struct struct-slots ] unit-test
+<<
+
+FUNCTOR: define-an-inline-word ( W -- )
+
+W DEFINES ${W}
+W-W DEFINES ${W}-${W}
+
+WHERE
+
+: W ( -- ) ; inline
+: W-W ( -- ) W W ;
+
+;FUNCTOR
+
+"an-inline-word" define-an-inline-word
+
+>>
+
+[ t ] [ \ an-inline-word inline? ] unit-test
+[ f ] [ \ an-inline-word-an-inline-word inline? ] unit-test
+
+<<
+
+FUNCTOR: define-a-final-class ( T W -- )
+
+T DEFINES-CLASS ${T}
+W DEFINES ${W}
+
+WHERE
+
+TUPLE: T ; final
+
+: W ( -- ) ;
+
+;FUNCTOR
+
+"a-final-tuple" "a-word" define-a-final-class
+
+>>
+
+[ t ] [ a-final-tuple final-class? ] unit-test
make suffix!
]
} case
- \ define-tuple-class suffix! ;
+ \ define-tuple-class* suffix! ;
+
+FUNCTOR-SYNTAX: final
+ [ word make-final ] append! ;
FUNCTOR-SYNTAX: SINGLETON:
scan-param suffix!
: find-device-axes-callback ( -- alien )
[ ! ( lpddoi pvRef -- BOOL )
- [ DIDEVICEOBJECTINSTANCEW memory>struct ] dip
+controller-devices+ get at
swap guidType>> {
{ [ dup GUID_XAxis = ] [ drop 0.0 >>x ] }
: find-controller-callback ( -- alien )
[ ! ( lpddi pvRef -- BOOL )
- drop DIDEVICEINSTANCEW memory>struct guidInstance>> add-controller
+ drop guidInstance>> add-controller
DIENUM_CONTINUE
] LPDIENUMDEVICESCALLBACKW ; inline
controller-state
keyboard-state
mouse-state
+}
+"Convenience functions are provided to convert a pair of key or button state sequences into a sequence of " { $link pressed } "/" { $link released } " deltas:"
+{ $subsections
+ button-delta
+ buttons-delta
+ buttons-delta-as
} ;
HELP: open-game-input
{ "A value of " { $link f } " in any slot (besides the elements of " { $snippet "buttons" } ") indicates that the corresponding element is not present on the device." } } } ;
HELP: keyboard-state
-{ $class-description "The " { $link read-keyboard } " word returns objects of this class. The " { $snippet "keys" } " slot of a " { $snippet "keyboard-state" } " object contains a " { $link sequence } " of 256 members representing the state of the keys on the keyboard. Each element is a boolean value indicating whether the corresponding key is pressed. The sequence is indexed by scancode as defined under usage page 7 of the USB HID standard. Named scancode constants are provided in the " { $vocab-link "game.input.scancodes" } " vocabulary." }
+{ $class-description "The " { $link read-keyboard } " word returns objects of this class. The " { $snippet "keys" } " slot of a " { $snippet "keyboard-state" } " object contains a " { $link sequence } " of 256 members representing the state of the keys on the keyboard. Each element is a boolean value indicating whether the corresponding key is pressed. The sequence is indexed by scancode as defined by the USB HID standard. Named scancode constants are provided in the " { $vocab-link "game.input.scancodes" } " vocabulary." }
{ $warning "The scancodes used to index " { $snippet "keyboard-state" } " objects correspond to physical key positions on the keyboard--they are unaffected by keymaps, modifier keys, or other operating environment postprocessing. The face value of the constants in " { $vocab-link "game.input.scancodes" } " do not necessarily correspond to what the user expects the key to type. Because of this, " { $link read-keyboard } " should not be used for text entry purposes. The Factor UI's standard gesture mechanism should be used in cases where the logical meaning of keypresses is needed; see " { $link "keyboard-gestures" } "." } ;
HELP: mouse-state
"Mouse movement is recorded relative to when the game input interface was opened with " { $link open-game-input } " or the mouse state is reset with " { $link reset-mouse } "."
} ;
-
{ keyboard-state read-keyboard } related-words
+HELP: button-delta
+{ $values { "old?" boolean } { "new?" boolean } { "delta" { $link pressed } ", " { $link released } ", or " { $link POSTPONE: f } } }
+{ $description "Outputs a symbol representing the change in a key or button's state given a \"before\" and \"after\" sample of its state. Outputs " { $link pressed } " if " { $snippet "old?" } " is false and " { $snippet "new?" } " is true, " { $link released } " if " { $snippet "old?" } " is true and " { $snippet "new?" } " is false, or " { $link POSTPONE: f } " if the two inputs have the same boolean value." } ;
+
+HELP: buttons-delta
+{ $values { "old-buttons" sequence } { "new-buttons" sequence } { "delta" "an array of " { $link pressed } ", " { $link released } ", or " { $link POSTPONE: f } } }
+{ $description "Outputs an array of symbols representing the change in a set of keys or buttons' states given \"before\" and \"after\" samples of their state. For each corresponding pair of values in the two input sequences, outputs " { $link pressed } " if " { $snippet "old-buttons" } " contains a false and " { $snippet "new-buttons" } " a true value, " { $link released } " if " { $snippet "old-buttons" } " contains true and " { $snippet "new-buttons" } " false, or " { $link POSTPONE: f } " if the two elements have the same boolean value."
+$nl
+"This word can be used with two samples of a " { $link keyboard-state } "'s " { $snippet "keys" } " slot or of a " { $link mouse-state } "'s or " { $link controller-state } "'s " { $snippet "buttons" } " slot to convert the button states into pressed/released values. Remember to " { $link clone } " state objects to record snapshots of their state." } ;
+
+HELP: buttons-delta-as
+{ $values { "old-buttons" sequence } { "new-buttons" sequence } { "exemplar" sequence } { "delta" "a sequence of " { $link pressed } ", " { $link released } ", or " { $link POSTPONE: f } } }
+{ $description "Like " { $link buttons-delta } ", but returns a sequence matching the type of the " { $snippet "exemplar" } "." } ;
+
+{ button-delta buttons-delta buttons-delta-as } related-words
+
+HELP: pressed
+{ $class-description "This symbol is returned by " { $link button-delta } " or " { $link buttons-delta } " to represent a button or key being pressed between two samples of its state." } ;
+
+HELP: released
+{ $class-description "This symbol is returned by " { $link button-delta } " or " { $link buttons-delta } " to represent a button or key being released between two samples of its state." } ;
+
+{ pressed released } related-words
+
ABOUT: "game-input"
[ ] [ 1 seconds sleep ] unit-test
[ ] [ close-game-input ] unit-test
] when
+
+[ f ] [ t t button-delta ] unit-test
+[ pressed ] [ f t button-delta ] unit-test
+[ released ] [ t f button-delta ] unit-test
+
+[ f ] [ 0.5 1.0 button-delta ] unit-test
+[ pressed ] [ f 0.7 button-delta ] unit-test
+[ released ] [ 0.2 f button-delta ] unit-test
+
+[ { pressed f f released } ] [ { f t f t } { t t f f } buttons-delta ] unit-test
+[ V{ pressed f f released } ] [ { f t f t } { t t f f } V{ } buttons-delta-as ] unit-test
M: mouse-state clone
call-next-method dup buttons>> clone >>buttons ;
+SYMBOLS: pressed released ;
+
+: button-delta ( old? new? -- delta )
+ {
+ { [ 2dup xor not ] [ 2drop f ] }
+ { [ dup not ] [ 2drop released ] }
+ { [ over not ] [ 2drop pressed ] }
+ } cond ; inline
+
+: buttons-delta-as ( old-buttons new-buttons exemplar -- delta )
+ [ button-delta ] swap 2map-as ; inline
+
+: buttons-delta ( old-buttons new-buttons -- delta )
+ { } buttons-delta-as ; inline
+
{
{ [ os windows? ] [ "game.input.xinput" require ] }
{ [ os macosx? ] [ "game.input.iokit" require ] }
- { [ t ] [ ] }
+ { [ os linux? ] [ "game.input.linux" require ] }
+ [ ]
} cond
--- /dev/null
+Erik Charlebois
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel game.input namespaces classes bit-arrays vectors ;
+IN: game.input.linux
+
+SINGLETON: linux-game-input-backend
+
+linux-game-input-backend game-input-backend set-global
+
+M: linux-game-input-backend (open-game-input)
+ ;
+
+M: linux-game-input-backend (close-game-input)
+ ;
+
+M: linux-game-input-backend (reset-game-input)
+ ;
+
+M: linux-game-input-backend get-controllers
+ { } ;
+
+M: linux-game-input-backend product-string
+ drop "" ;
+
+M: linux-game-input-backend product-id
+ drop f ;
+
+M: linux-game-input-backend instance-id
+ drop f ;
+
+M: linux-game-input-backend read-controller
+ drop controller-state new ;
+
+M: linux-game-input-backend calibrate-controller
+ drop ;
+
+M: linux-game-input-backend vibrate-controller
+ 3drop ;
+
+M: linux-game-input-backend read-keyboard
+ 256 <bit-array> keyboard-state boa ;
+
+M: linux-game-input-backend read-mouse
+ 0 0 0 0 2 <vector> mouse-state boa ;
+
+M: linux-game-input-backend reset-mouse
+ ;
--- /dev/null
+Linux backend for game input.
-USING: tools.test globs ;
+USING: arrays tools.test globs io.pathnames sequences ;
IN: globs.tests
[ f ] [ "abd" "fdf" glob-matches? ] unit-test
[ f ] [ "foo." "*.{xml,txt}" glob-matches? ] unit-test
[ t ] [ "foo." "*.{,xml,txt}" glob-matches? ] unit-test
[ t ] [ "foo.{" "*.{" glob-matches? ] unit-test
+
+[ f ] [ "foo" "bar" append-path "*" glob-matches? ] unit-test
+[ t ] [ "foo" "bar" append-path "*" "*" append-path glob-matches? ] unit-test
+[ f ] [ "foo" "bar" append-path "foo?bar" glob-matches? ] unit-test
+[ t ] [ "foo" "bar" append-path "fo?" "bar" append-path glob-matches? ] unit-test
+
+[ f ] [ "foo" glob-pattern? ] unit-test
+[ t ] [ "fo?" glob-pattern? ] unit-test
+[ t ] [ "fo*" glob-pattern? ] unit-test
+[ t ] [ "fo[mno]" glob-pattern? ] unit-test
+[ t ] [ "fo\\*" glob-pattern? ] unit-test
+[ t ] [ "fo{o,bro}" glob-pattern? ] unit-test
+
+{ "foo" "bar" } path-separator join 1array
+[ { "foo" "bar" "ba?" } path-separator join glob-parent-directory ] unit-test
+
+[ "foo" ]
+[ { "foo" "b?r" "bas" } path-separator join glob-parent-directory ] unit-test
+
+[ "" ]
+[ { "f*" "bar" "bas" } path-separator join glob-parent-directory ] unit-test
! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
-USING: sequences kernel regexp.combinators strings unicode.case
-peg.ebnf regexp arrays ;
+USING: sequences io.pathnames kernel regexp.combinators
+strings splitting system unicode.case peg.ebnf regexp arrays ;
IN: globs
+: not-path-separator ( -- sep )
+ os windows? R! [^/\\]! R! [^/]! ? ; foldable
+
EBNF: <glob>
Character = "\\" .:c => [[ c 1string <literal> ]]
AlternationBody = Concatenation:c "," AlternationBody:a => [[ a c prefix ]]
| Concatenation => [[ 1array ]]
-Element = "*" => [[ R/ .*/ ]]
- | "?" => [[ R/ ./ ]]
+Element = "*" => [[ not-path-separator <zero-or-more> ]]
+ | "?" => [[ not-path-separator ]]
| "[" CharClass:c "]" => [[ c ]]
| "{" AlternationBody:b "}" => [[ b <or> ]]
| Character
: glob-matches? ( input glob -- ? )
[ >case-fold ] bi@ <glob> matches? ;
+
+: glob-pattern? ( string -- ? )
+ [ "\\*?[{" member? ] any? ;
+
+: glob-parent-directory ( glob -- parent-directory )
+ path-separator split harvest dup [ glob-pattern? ] find drop head
+ path-separator join ;
{ $subsections groups <groups> <sliced-groups> }
"Splitting a sequence into overlapping, fixed-length subsequences:"
{ $subsections clump }
+"Splitting a sequence into overlapping, fixed-length subsequences, wrapping around the end of the sequence:"
+{ $subsections circular-clump }
"A virtual sequence for splitting a sequence into overlapping, fixed-length subsequences:"
{ $subsections clumps <clumps> <sliced-clumps> }
+"A virtual sequence for splitting a sequence into overlapping, fixed-length subsequences:"
+{ $subsections circular-clumps <circular-clumps> <sliced-circular-clumps> }
"The difference can be summarized as the following:"
{ $list
{ "With groups, the subsequences form the original sequence when concatenated:"
+ { $unchecked-example
+ "USING: grouping ;"
+ "{ 1 2 3 4 } 2 group ." "{ { 1 2 } { 3 4 } }"
+ }
{ $unchecked-example
"USING: grouping ;"
"{ 1 2 3 4 } dup" "2 <groups> concat sequence= ." "t"
}
}
{ "With clumps, collecting the first element of each subsequence but the last one, together with the last subseqence, yields the original sequence:"
+ { $unchecked-example
+ "USING: grouping ;"
+ "{ 1 2 3 4 } 2 clump ." "{ { 1 2 } { 2 3 } { 3 4 } }"
+ }
{ $unchecked-example
"USING: grouping ;"
"{ 1 2 3 4 } dup" "2 <clumps> unclip-last [ [ first ] map ] dip append sequence= ." "t"
}
}
+ { "With circular clumps, collecting the first element of each subsequence yields the original sequence. Collecting the " { $snippet "n" } "th element of each subsequence would rotate the original sequence " { $snippet "n" } " elements rightward:"
+ { $unchecked-example
+ "USING: grouping ;"
+ "{ 1 2 3 4 } 2 circular-clump ." "{ { 1 2 } { 2 3 } { 3 4 } { 4 1 } }"
+ }
+ { $unchecked-example
+ "USING: grouping ;"
+ "{ 1 2 3 4 } dup" "2 <circular-clumps> [ first ] map sequence= ." "t"
+ }
+ { $unchecked-example
+ "USING: grouping ;"
+ "{ 1 2 3 4 } dup" "2 <circular-clumps> [ second ] { } map-as ." "{ 2 3 4 1 }"
+ }
+ }
}
$nl
"A combinator built using clumps:"
} ;
HELP: clumps
-{ $class-description "Instances are virtual sequences whose elements are overlapping fixed-length subsequences o an underlying sequence. Clumps are mutable and resizable if the underlying sequence is mutable and resizable, respectively."
+{ $class-description "Instances are virtual sequences whose elements are overlapping fixed-length subsequences of an underlying sequence. Clumps are mutable and resizable if the underlying sequence is mutable and resizable, respectively."
$nl
"New clumps are created by calling " { $link <clumps> } " and " { $link <sliced-clumps> } "." } ;
+HELP: circular-clumps
+{ $class-description "Instances are virtual sequences whose elements are overlapping fixed-length subsequences of an underlying sequence, beginning with every element in the original sequence and wrapping around its end. Circular clumps are mutable and resizable if the underlying sequence is mutable and resizable, respectively."
+$nl
+"New clumps are created by calling " { $link <circular-clumps> } " and " { $link <sliced-circular-clumps> } "." } ;
+
HELP: clump
{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "array" "a sequence of sequences" } }
{ $description "Splits the sequence into overlapping clumps of " { $snippet "n" } " elements and collects the clumps into a new array." }
-{ $errors "Throws an error if " { $snippet "n" } " is smaller than the length of the sequence." }
+{ $errors "Throws an error if " { $snippet "n" } " is larger than the length of the sequence." }
{ $examples
{ $example "USING: grouping prettyprint ;" "{ 3 1 3 3 7 } 2 clump ." "{ { 3 1 } { 1 3 } { 3 3 } { 3 7 } }" }
} ;
+HELP: circular-clump
+{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "array" "a sequence of sequences" } }
+{ $description "Splits the sequence into overlapping clumps of " { $snippet "n" } " elements, wrapping around the end of the sequence, and collects the clumps into a new array." }
+{ $errors "Throws an error if " { $snippet "n" } " is larger than the length of the sequence." }
+{ $examples
+ { $example "USING: grouping prettyprint ;" "{ 3 1 3 3 7 } 2 circular-clump ." "{ { 3 1 } { 1 3 } { 3 3 } { 3 7 } { 7 3 } }" }
+} ;
+
HELP: <clumps>
{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "clumps" clumps } }
{ $description "Outputs a virtual sequence whose elements are overlapping subsequences of " { $snippet "n" } " elements from the underlying sequence." }
}
} ;
-HELP: <sliced-clumps>
+HELP: <circular-clumps>
{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "clumps" clumps } }
-{ $description "Outputs a virtual sequence whose elements are overlapping slices of " { $snippet "n" } " elements from the underlying sequence." }
+{ $description "Outputs a virtual sequence whose elements are overlapping subsequences of " { $snippet "n" } " elements from the underlying sequence, starting with each of its elements and wrapping around the end of the sequence." }
{ $examples
{ $example
"USING: kernel sequences grouping prettyprint ;"
- "{ 1 2 3 4 5 6 } 3 <sliced-clumps> second ."
- "T{ slice { from 1 } { to 4 } { seq { 1 2 3 4 5 6 } } }"
+ "{ 1 2 3 4 } 3 <circular-clumps> third ."
+ "{ 3 4 1 }"
+ }
+} ;
+
+HELP: <sliced-circular-clumps>
+{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "clumps" clumps } }
+{ $description "Outputs a virtual sequence whose elements are overlapping slices of " { $snippet "n" } " elements from the underlying sequence, starting with each of its elements and wrapping around the end of the sequence." }
+{ $examples
+ { $example
+ "USING: arrays kernel sequences grouping prettyprint ;"
+ "{ 1 2 3 4 } 3 <sliced-circular-clumps> third >array ."
+ "{ 3 4 1 }"
}
} ;
-{ clumps groups } related-words
+{ clumps circular-clumps groups } related-words
-{ clump group } related-words
+{ clump circular-clump group } related-words
-{ <clumps> <groups> } related-words
+{ <clumps> <circular-clumps> <groups> } related-words
-{ <sliced-clumps> <sliced-groups> } related-words
+{ <sliced-clumps> <sliced-circular-clumps> <sliced-groups> } related-words
HELP: monotonic?
{ $values { "seq" sequence } { "quot" { $quotation "( elt elt -- ? )" } } { "?" "a boolean" } }
[ 1 ] [ { 1 2 } 2 <clumps> length ] unit-test
[ 2 ] [ { 1 2 3 } 2 <clumps> length ] unit-test
+[ { } 2 <circular-clumps> length ] must-fail
+[ { 1 } 2 <circular-clumps> length ] must-fail
+
+[ 2 ] [ { 1 2 } 2 <circular-clumps> length ] unit-test
+[ 3 ] [ { 1 2 3 } 2 <circular-clumps> length ] unit-test
+
+[ { { 1 2 } { 2 1 } } ] [ { 1 2 } 2 circular-clump ] unit-test
+[ { { 1 2 } { 2 3 } { 3 1 } } ] [ { 1 2 3 } 2 circular-clump ] unit-test
+
[ 1 ] [ V{ } 2 <clumps> 0 over set-length seq>> length ] unit-test
[ 2 ] [ V{ } 2 <clumps> 1 over set-length seq>> length ] unit-test
[ 3 ] [ V{ } 2 <clumps> 2 over set-length seq>> length ] unit-test
! Copyright (C) 2005, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.order strings arrays vectors sequences
-sequences.private accessors fry ;
+sequences.private accessors fry combinators.short-circuit ;
IN: grouping
<PRIVATE
: new-groups ( seq n class -- groups )
[ check-groups ] dip boa ; inline
+: slice-mod ( n length -- n' )
+ 2dup >= [ - ] [ drop ] if ; inline
+
+: check-circular-clumps ( seq n -- seq n )
+ 2dup { [ nip 0 <= ] [ swap length > ] } 2||
+ [ "Invalid clump size" throw ] when ; inline
+
PRIVATE>
TUPLE: groups < chunking-seq ;
: all-equal? ( seq -- ? ) [ = ] monotonic? ;
: all-eq? ( seq -- ? ) [ eq? ] monotonic? ;
+
+TUPLE: circular-slice < slice ;
+M: circular-slice virtual@
+ [ from>> + ] [ seq>> ] bi [ length slice-mod ] keep ; inline
+
+C: <circular-slice> circular-slice
+
+TUPLE: sliced-circular-clumps < chunking-seq ;
+INSTANCE: sliced-circular-clumps sequence
+
+M: sliced-circular-clumps length
+ seq>> length ; inline
+
+M: sliced-circular-clumps nth
+ [ n>> over + ] [ seq>> ] bi <circular-slice> ; inline
+
+: <sliced-circular-clumps> ( seq n -- clumps )
+ check-circular-clumps sliced-circular-clumps boa ; inline
+
+TUPLE: circular-clumps < chunking-seq ;
+INSTANCE: circular-clumps sequence
+
+M: circular-clumps length
+ seq>> length ; inline
+
+M: circular-clumps nth
+ [ n>> over + ] [ seq>> ] bi [ <circular-slice> ] [ like ] bi ; inline
+
+: <circular-clumps> ( seq n -- clumps )
+ check-circular-clumps circular-clumps boa ; inline
+
+: circular-clump ( seq n -- array )
+ <circular-clumps> { } like ; inline
+
: extract-values ( element -- seq )
\ $values swap elements dup empty? [
- first rest [ first ] map prune
+ first rest [ first ] map
] unless ;
: effect-values ( word -- seq )
"Examples" $heading print-element ;
: $example ( element -- )
- 1 cut* swap "\n" join dup <input> [
- input-style get format nl print-element
+ 1 cut* [ "\n" join ] bi@ over <input> [
+ [ print ] [ output-style get format ] bi*
] ($code) ;
: $unchecked-example ( element -- )
{ wrap-margin f }
} code-style set-global
-SYMBOL: input-style
-H{ { font-style bold } } input-style set-global
+SYMBOL: output-style
+H{
+ { font-style bold }
+ { foreground COLOR: DarkOrange4 }
+} output-style set-global
SYMBOL: url-style
H{
HELP: normalize-image
{ $values
{ "image" image }
- { "image" image }
+ { "image'" image }
}
{ $description "Converts the image to RGBA with ubyte-components. If the image is upside-down, it will be flipped right side up such that the 1st byte in the bitmap slot's byte array corresponds to the first color component of the pixel in the upper-left corner of the image." } ;
HELP: reorder-components
{ $values
{ "image" image } { "component-order" component-order }
- { "image" image }
+ { "image'" image }
}
{ $description "Convert the bitmap in " { $snippet "image" } " such that the pixel sample layout corresponds to " { $snippet "component-order" } ". If the destination layout cannot find a corresponding value from the source layout, the value " { $snippet "255" } " will be substituted for that byte." }
{ $warning "The image's " { $snippet "component-type" } " will be changed to " { $snippet "ubyte-components" } " if it is not already in that format."
M: ubyte-components normalize-component-type*
drop ;
-: normalize-scan-line-order ( image -- image )
+: normalize-scan-line-order ( image -- image' )
dup upside-down?>> [
dup dim>> first 4 * '[
_ <groups> reverse concat
PRIVATE>
-: reorder-components ( image component-order -- image )
+: reorder-components ( image component-order -- image' )
[
dup component-type>> '[ _ normalize-component-type* ] change-bitmap
dup component-order>>
] dip
validate-request [ (reorder-components) ] keep >>component-order ;
-: normalize-image ( image -- image )
+: normalize-image ( image -- image' )
[ >byte-array ] change-bitmap
RGBA reorder-components
normalize-scan-line-order ;
IN: images.processing\r
\r
: coord-matrix ( dim -- m )\r
- [ iota ] map first2 [ [ 2array ] with map ] curry map ;\r
+ [ iota ] map first2 cartesian-product ;\r
\r
: map^2 ( m quot -- m' ) '[ _ map ] map ; inline\r
: each^2 ( m quot -- m' ) '[ _ each ] each ; inline\r
-bitmap graphics
+graphics
! Copyright (C) 2007, 2009 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel locals words summary slots quotations
-sequences assocs math arrays stack-checker effects
-continuations debugger classes.tuple namespaces make vectors
-bit-arrays byte-arrays strings sbufs math.functions macros
-sequences.private combinators mirrors splitting combinators.smart
+sequences assocs math arrays stack-checker effects continuations
+classes.tuple namespaces make vectors bit-arrays byte-arrays
+strings sbufs math.functions macros sequences.private
+combinators mirrors splitting combinators.smart
combinators.short-circuit fry words.symbol generalizations
classes ;
IN: inverse
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types kernel bit-arrays sequences assocs unix
-math namespaces accessors math.order locals unix.time fry
-io.ports io.backend.unix io.backend.unix.multiplexers ;
+USING: alien.c-types kernel bit-arrays sequences assocs math
+namespaces accessors math.order locals fry io.ports
+io.backend.unix io.backend.unix.multiplexers unix unix.ffi
+unix.time ;
IN: io.backend.unix.multiplexers.select
TUPLE: select-mx < mx read-fdset write-fdset ;
+++ /dev/null
-unportable
+++ /dev/null
-unportable\r
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
strings accessors destructors ;
: buffer-set ( string buffer -- )
- over >byte-array over ptr>> byte-array>memory
- [ length ] dip buffer-reset ;
+ [ ptr>> swap >byte-array binary-object memcpy ]
+ [ [ length ] dip buffer-reset ]
+ 2bi ;
: string>buffer ( string -- buffer )
dup length <buffer> [ buffer-set ] keep ;
HINTS: n>buffer fixnum buffer ;
: >buffer ( byte-array buffer -- )
- [ buffer-end byte-array>memory ]
- [ [ length ] dip n>buffer ]
+ [ buffer-end swap binary-object memcpy ]
+ [ [ byte-length ] dip n>buffer ]
2bi ;
HINTS: >buffer byte-array buffer ;
{ $values { "path" "a pathname string" } { "seq" "a sequence of filenames" } }
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." } ;
+HELP: directory-tree-files
+{ $values { "path" "a pathname string" } { "seq" "a sequence of filenames" } }
+{ $description "Outputs a sequence of all files and subdirectories inside the directory named by " { $snippet "path" } " or recursively inside its subdirectories." } ;
+
HELP: with-directory-files
{ $values { "path" "a pathname string" } { "quot" quotation } }
{ $description "Calls the quotation with the directory file names on the stack and with the directory set as the " { $link current-directory } ". Restores the current directory after the quotation is called." } ;
+HELP: with-directory-tree-files
+{ $values { "path" "a pathname string" } { "quot" quotation } }
+{ $description "Calls the quotation with the recursive directory file names on the stack and with the directory set as the " { $link current-directory } ". Restores the current directory after the quotation is called." } ;
+
HELP: with-directory-entries
{ $values { "path" "a pathname string" } { "quot" quotation } }
{ $description "Calls the quotation with the directory entries on the stack and with the directory set as the " { $link current-directory } ". Restores the current directory after the quotation is called." } ;
] with-directory-files
] unit-test
+[ { "classes/tuple/tuple.factor" } ] [
+ "resource:core" [
+ "." directory-tree-files [ "classes/tuple/tuple.factor" = ] filter
+ ] with-directory
+] unit-test
+
+[ { "classes/tuple" } ] [
+ "resource:core" [
+ "." directory-tree-files [ "classes/tuple" = ] filter
+ ] with-directory
+] unit-test
+
+[ { "classes/tuple/tuple.factor" } ] [
+ "resource:core" [
+ [ "classes/tuple/tuple.factor" = ] filter
+ ] with-directory-tree-files
+] unit-test
+
[ ] [ "blahblah" temp-file dup exists? [ delete-directory ] [ drop ] if ] unit-test
[ ] [ "blahblah" temp-file make-directory ] unit-test
[ t ] [ "blahblah" temp-file file-info directory? ] unit-test
! Copyright (C) 2004, 2008 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators destructors io io.backend
-io.encodings.binary io.files io.pathnames kernel namespaces
-sequences system vocabs.loader fry ;
+USING: accessors arrays combinators destructors io io.backend
+io.encodings.binary io.files io.files.types io.pathnames
+kernel namespaces sequences system vocabs.loader fry ;
IN: io.directories
: set-current-directory ( path -- )
: directory-files ( path -- seq )
directory-entries [ name>> ] map ;
+: directory-tree-files ( path -- seq )
+ dup directory-entries
+ [
+ dup type>> +directory+ =
+ [ name>>
+ [ append-path directory-tree-files ]
+ [ [ prepend-path ] curry map ]
+ [ prefix ] tri
+ ] [ nip name>> 1array ] if
+ ] with map concat ;
+
: with-directory-entries ( path quot -- )
'[ "" directory-entries @ ] with-directory ; inline
: with-directory-files ( path quot -- )
'[ "" directory-files @ ] with-directory ; inline
+: with-directory-tree-files ( path quot -- )
+ '[ "" directory-tree-files @ ] with-directory ; inline
+
! Touching files
HOOK: touch-file io-backend ( path -- )
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
[ { CHAR: replacement-character } ] [ B{ 0 } utf32be decode >array ] unit-test
[ { } ] [ { } utf32be decode >array ] unit-test
-[ { 0 0 0 CHAR: x 0 1 HEX: D1 HEX: 1E } ] [ { CHAR: x HEX: 1d11e } >string utf32be encode >array ] unit-test
+[ B{ 0 0 0 CHAR: x 0 1 HEX: D1 HEX: 1E } ] [ { CHAR: x HEX: 1d11e } >string utf32be encode ] unit-test
[ { CHAR: x } ] [ B{ CHAR: x 0 0 0 } utf32le decode >array ] unit-test
[ { HEX: 1d11e } ] [ B{ HEX: 1e HEX: d1 1 0 } utf32le decode >array ] unit-test
[ { CHAR: replacement-character } ] [ B{ HEX: 1e } utf32le decode >array ] unit-test
[ { } ] [ { } utf32le decode >array ] unit-test
-[ { 120 0 0 0 HEX: 1e HEX: d1 1 0 } ] [ { CHAR: x HEX: 1d11e } >string utf32le encode >array ] unit-test
+[ B{ 120 0 0 0 HEX: 1e HEX: d1 1 0 } ] [ { CHAR: x HEX: 1d11e } >string utf32le encode ] unit-test
[ { CHAR: x } ] [ B{ HEX: ff HEX: fe 0 0 CHAR: x 0 0 0 } utf32 decode >array ] unit-test
[ { CHAR: x } ] [ B{ 0 0 HEX: fe HEX: ff 0 0 0 CHAR: x } utf32 decode >array ] unit-test
-[ { HEX: ff HEX: fe 0 0 120 0 0 0 HEX: 1e HEX: d1 1 0 } ] [ { CHAR: x HEX: 1d11e } >string utf32 encode >array ] unit-test
+[ B{ HEX: ff HEX: fe 0 0 120 0 0 0 HEX: 1e HEX: d1 1 0 } ] [ { CHAR: x HEX: 1d11e } >string utf32 encode ] unit-test
+++ /dev/null
-unportable
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.syntax combinators
+USING: accessors alien alien.c-types alien.syntax combinators
io.backend io.files io.files.info io.files.unix kernel math system unix
unix.statfs.freebsd unix.statvfs.freebsd unix.getfsstat.freebsd
sequences grouping alien.strings io.encodings.utf8 unix.types
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel unix.stat math unix
+USING: alien alien.syntax kernel unix.stat math unix
combinators system io.backend accessors alien.c-types
io.encodings.utf8 alien.strings unix.types io.files.unix
io.files io.files.info unix.statvfs.netbsd unix.getfsstat.netbsd arrays
+++ /dev/null
-unportable
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.strings alien.syntax
+USING: accessors alien alien.c-types alien.strings alien.syntax
combinators io.backend io.files io.files.info io.files.unix kernel math
sequences system unix unix.getfsstat.openbsd grouping
unix.statfs.openbsd unix.statvfs.openbsd unix.types
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-IN: io.launcher.unix.parser.tests
-USING: io.launcher.unix.parser tools.test ;
-
-[ "" tokenize-command ] must-fail
-[ " " tokenize-command ] must-fail
-[ V{ "a" } ] [ "a" tokenize-command ] unit-test
-[ V{ "abc" } ] [ "abc" tokenize-command ] unit-test
-[ V{ "abc" } ] [ "abc " tokenize-command ] unit-test
-[ V{ "abc" } ] [ " abc" tokenize-command ] unit-test
-[ V{ "abc" "def" } ] [ "abc def" tokenize-command ] unit-test
-[ V{ "abc def" } ] [ "abc\\ def" tokenize-command ] unit-test
-[ V{ "abc\\" "def" } ] [ "abc\\\\ def" tokenize-command ] unit-test
-[ V{ "abc\\ def" } ] [ "\"abc\\\\ def\"" tokenize-command ] unit-test
-[ V{ "abc\\ def" } ] [ " \"abc\\\\ def\"" tokenize-command ] unit-test
-[ V{ "abc\\ def" "hey" } ] [ "\"abc\\\\ def\" hey" tokenize-command ] unit-test
-[ V{ "abc def" "hey" } ] [ "\"abc def\" \"hey\"" tokenize-command ] unit-test
-[ "\"abc def\" \"hey" tokenize-command ] must-fail
-[ "\"abc def" tokenize-command ] must-fail
-[ V{ "abc def" "h\"ey" } ] [ "\"abc def\" \"h\\\"ey\" " tokenize-command ] unit-test
-
-[
- V{
- "Hello world.app/Contents/MacOS/hello-ui"
- "-i=boot.macosx-ppc.image"
- "-include= math compiler ui"
- "-deploy-vocab=hello-ui"
- "-output-image=Hello world.app/Contents/Resources/hello-ui.image"
- "-no-stack-traces"
- "-no-user-init"
- }
-] [
- "\"Hello world.app/Contents/MacOS/hello-ui\" -i=boot.macosx-ppc.image \"-include= math compiler ui\" -deploy-vocab=hello-ui \"-output-image=Hello world.app/Contents/Resources/hello-ui.image\" -no-stack-traces -no-user-init" tokenize-command
-] unit-test
+++ /dev/null
-! Copyright (C) 2008 Slava Pestov
-! See http://factorcode.org/license.txt for BSD license.
-USING: peg peg.ebnf arrays sequences strings kernel ;
-IN: io.launcher.unix.parser
-
-! Our command line parser. Supported syntax:
-! foo bar baz -- simple tokens
-! foo\ bar -- escaping the space
-! "foo bar" -- quotation
-EBNF: tokenize-command
-space = " "
-escaped-char = "\" .:ch => [[ ch ]]
-quoted = '"' (escaped-char | [^"])*:a '"' => [[ a ]]
-unquoted = (escaped-char | [^ "])+
-argument = (quoted | unquoted) => [[ >string ]]
-command = space* (argument:a space* => [[ a ]])+:c !(.) => [[ c ]]
-;EBNF
+++ /dev/null
-unportable
+++ /dev/null
-unportable
-! Copyright (C) 2007, 2008 Slava Pestov.
+! Copyright (C) 2007, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types arrays assocs combinators
continuations environment io io.backend io.backend.unix
-io.files io.files.private io.files.unix io.launcher
-io.launcher.unix.parser io.pathnames io.ports kernel math
-namespaces sequences strings system threads unix
-unix.process unix.ffi ;
+io.files io.files.private io.files.unix io.launcher io.pathnames
+io.ports kernel math namespaces sequences strings system threads
+unix unix.process unix.ffi simple-tokenizer ;
IN: io.launcher.unix
: get-arguments ( process -- seq )
- command>> dup string? [ tokenize-command ] when ;
+ command>> dup string? [ tokenize ] when ;
: assoc>env ( assoc -- env )
[ "=" glue ] { } assoc>map ;
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
[ inotify>> handle>> handle-fd ] [ wd>> ] bi
inotify_rm_watch io-error
] if
- ] bi ;
+ ]
+ [ call-next-method ]
+ tri ;
: ignore-flags? ( mask -- ? )
{
+++ /dev/null
-unportable
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io.backend io.monitors
core-foundation.fsevents continuations kernel sequences
dup [ enqueue-notifications ] curry
path 1array 0 0 <event-stream> >>handle ;
-M: macosx-monitor dispose* handle>> dispose ;
+M: macosx-monitor dispose*
+ [ handle>> dispose ] [ call-next-method ] bi ;
macosx set-io-backend
+++ /dev/null
-unportable
continuations namespaces concurrency.count-downs kernel io
threads calendar prettyprint destructors io.timeouts
io.files.temp io.directories io.directories.hierarchy
-io.pathnames accessors ;
+io.pathnames accessors concurrency.promises ;
os { winnt linux macosx } member? [
[
[ [ t ] [ "m" get next-change drop ] while ] must-fail
[ ] [ "m" get dispose ] unit-test
] with-monitors
+
+ ! Disposing a monitor should throw an error in any threads
+ ! waiting on notifications
+ [
+ [ ] [
+ <promise> "p" set
+ "monitor-test" temp-file t <monitor> "m" set
+ 10 seconds "m" get set-timeout
+ ] unit-test
+
+ [
+ [ "m" get next-change ] [ ] recover
+ "p" get fulfill
+ ] in-thread
+
+ [ ] [ 1 seconds sleep ] unit-test
+ [ ] [ "m" get dispose ] unit-test
+ [ t ] [ "p" get 10 seconds ?promise-timeout already-disposed? ] unit-test
+ ] with-monitors
] when
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io.backend kernel continuations destructors namespaces
sequences assocs hashtables sorting arrays threads boxes
M: monitor set-timeout (>>timeout) ;
+<PRIVATE
+
+SYMBOL: monitor-disposed
+
+PRIVATE>
+
+M: monitor dispose*
+ [ monitor-disposed ] dip queue>> mailbox-put ;
+
: new-monitor ( path mailbox class -- monitor )
new-disposable
swap >>queue
TUPLE: file-change path changed monitor ;
: queue-change ( path changes monitor -- )
- 3dup and and
- [ [ file-change boa ] keep queue>> mailbox-put ] [ 3drop ] if ;
+ 3dup and and [
+ [ check-disposed ] keep
+ [ file-change boa ] keep
+ queue>> mailbox-put
+ ] [ 3drop ] if ;
HOOK: (monitor) io-backend ( path recursive? mailbox -- monitor )
<mailbox> (monitor) ;
: next-change ( monitor -- change )
- [ queue>> ] [ timeout ] bi mailbox-get-timeout ;
+ [ check-disposed ]
+ [
+ [ ] [ queue>> ] [ timeout ] tri mailbox-get-timeout
+ dup monitor-disposed eq? [ drop already-disposed ] [ nip ] if
+ ] bi ;
SYMBOL: +add-file+
SYMBOL: +remove-file+
: remove-child-monitor ( monitor -- )
monitor tget children>> delete-at* [ dispose ] [ drop ] if ;
+SYMBOL: +stop+
+
M: recursive-monitor dispose*
- [ "stop" swap thread>> send-synchronous drop ]
- [ queue>> dispose ]
- bi ;
+ [ [ +stop+ ] dip thread>> send ] [ call-next-method ] bi ;
: stop-pump ( -- )
monitor tget children>> values dispose-each ;
: pump-step ( msg -- )
- [ [ monitor>> path>> ] [ path>> ] bi append-path ] [ changed>> ] bi
- monitor tget queue-change ;
+ monitor tget disposed>> [ drop ] [
+ [ [ monitor>> path>> ] [ path>> ] bi append-path ] [ changed>> ] bi
+ monitor tget queue-change
+ ] if ;
: child-added ( path monitor -- )
path>> prepend-path add-child-monitor ;
] with with each ;
: pump-loop ( -- )
- receive dup synchronous? [
- [ stop-pump t ] dip reply-synchronous
+ receive dup +stop+ eq? [
+ drop stop-pump
] [
[ '[ _ update-hierarchy ] ignore-errors ] [ pump-step ] bi
pump-loop
] with-destructors ;
M: win32-monitor dispose
- port>> dispose ;
+ [ port>> dispose ] [ call-next-method ] bi ;
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
--- /dev/null
+USING: destructors io io.directories io.encodings.binary
+io.files io.files.temp kernel libc math sequences
+specialized-arrays.instances.alien.c-types.int tools.test ;
+IN: io.ports.tests
+
+! Make sure that writing malloced storage to a file works, and
+! also make sure that writes larger than the buffer size work
+
+[ ] [
+ "test.txt" temp-file binary [
+ [
+ 100,000 iota
+ 0
+ 100,000 malloc-int-array &free [ copy ] keep write
+ ] with-destructors
+ ] with-file-writer
+] unit-test
+
+[ t ] [
+ "test.txt" temp-file binary [
+ 100,000 4 * read byte-array>int-array 100,000 iota sequence=
+ ] with-file-reader
+] unit-test
+
+[ ] [ "test.txt" temp-file delete-file ] unit-test
-! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman
+! Copyright (C) 2005, 2010 Slava Pestov, Doug Coleman
! See http://factorcode.org/license.txt for BSD license.
USING: math kernel io sequences io.buffers io.timeouts generic
byte-vectors system io.encodings math.order io.backend
-continuations classes byte-arrays namespaces splitting
-grouping dlists assocs io.encodings.binary summary accessors
-destructors combinators ;
+continuations classes byte-arrays namespaces splitting grouping
+dlists alien alien.c-types assocs io.encodings.binary summary
+accessors destructors combinators fry specialized-arrays ;
+SPECIALIZED-ARRAY: uchar
IN: io.ports
SYMBOL: default-buffer-size
1 over wait-to-write
buffer>> byte>buffer ; inline
+: write-in-groups ( byte-array port -- )
+ [ binary-object <direct-uchar-array> ] dip
+ [ buffer>> size>> <groups> ] [ '[ _ stream-write ] ] bi
+ each ;
+
M: output-port stream-write
dup check-disposed
- over length over buffer>> size>> > [
- [ buffer>> size>> <groups> ]
- [ [ stream-write ] curry ] bi
- each
+ 2dup [ byte-length ] [ buffer>> size>> ] bi* > [
+ write-in-groups
] [
- [ [ length ] dip wait-to-write ]
+ [ [ byte-length ] dip wait-to-write ]
[ buffer>> >buffer ] 2bi
] if ;
+++ /dev/null
-unportable
parse-sockaddr ;
: parse-addrinfo-list ( addrinfo -- seq )
- [ next>> dup [ addrinfo memory>struct ] when ] follow
+ [ next>> ] follow
[ addrinfo>addrspec ] map
sift ;
+++ /dev/null
-unportable
[ lpOverlapped>> ]
[ ptr>> ]
} cleave
- "int"
- { "SOCKET" "sockaddr_in*" "int" "PVOID" "DWORD" "LPDWORD" "void*" }
+ int
+ { SOCKET void* int PVOID DWORD LPDWORD void* }
"stdcall" alien-indirect drop
winsock-error-string [ throw ] when* ; inline
+++ /dev/null
-unportable
+++ /dev/null
-unportable
FUNCTION: IOReturn IOHIDDeviceCopyValueMultiple ( IOHIDDeviceRef device, CFArrayRef elements, CFDictionaryRef* pMultiple ) ;
FUNCTION: IOReturn IOHIDDeviceGetValueWithCallback ( IOHIDDeviceRef device, IOHIDElementRef element, IOHIDValueRef* pValue, CFTimeInterval timeout, IOHIDValueCallback callback, void* context ) ;
FUNCTION: IOReturn IOHIDDeviceCopyValueMultipleWithCallback ( IOHIDDeviceRef device, CFArrayRef elements, CFDictionaryRef* pMultiple, CFTimeInterval timeout, IOHIDValueMultipleCallback callback, void* context ) ;
-FUNCTION: IOReturn IOHIDDeviceSetReport ( IOHIDDeviceRef device, IOHIDReportType reportType, CFIndex reportID, uchar* report, CFIndex reportLength ) ;
-FUNCTION: IOReturn IOHIDDeviceSetReportWithCallback ( IOHIDDeviceRef device, IOHIDReportType reportType, CFIndex reportID, uchar* report, CFIndex reportLength, CFTimeInterval timeout, IOHIDReportCallback callback, void* context ) ;
-FUNCTION: IOReturn IOHIDDeviceGetReport ( IOHIDDeviceRef device, IOHIDReportType reportType, CFIndex reportID, uchar* report, CFIndex* pReportLength ) ;
-FUNCTION: IOReturn IOHIDDeviceGetReportWithCallback ( IOHIDDeviceRef device, IOHIDReportType reportType, CFIndex reportID, uchar* report, CFIndex* pReportLength, CFTimeInterval timeout, IOHIDReportCallback callback, void* context ) ;
+FUNCTION: IOReturn IOHIDDeviceSetReport ( IOHIDDeviceRef device, IOHIDReportType reportType, CFIndex reportID, char* report, CFIndex reportLength ) ;
+FUNCTION: IOReturn IOHIDDeviceSetReportWithCallback ( IOHIDDeviceRef device, IOHIDReportType reportType, CFIndex reportID, char* report, CFIndex reportLength, CFTimeInterval timeout, IOHIDReportCallback callback, void* context ) ;
+FUNCTION: IOReturn IOHIDDeviceGetReport ( IOHIDDeviceRef device, IOHIDReportType reportType, CFIndex reportID, char* report, CFIndex* pReportLength ) ;
+FUNCTION: IOReturn IOHIDDeviceGetReportWithCallback ( IOHIDDeviceRef device, IOHIDReportType reportType, CFIndex reportID, char* report, CFIndex* pReportLength, CFTimeInterval timeout, IOHIDReportCallback callback, void* context ) ;
! IOHIDManager
FUNCTION: CFTypeID IOHIDValueGetTypeID ( ) ;
FUNCTION: IOHIDValueRef IOHIDValueCreateWithIntegerValue ( CFAllocatorRef allocator, IOHIDElementRef element, ulonglong timeStamp, CFIndex value ) ;
-FUNCTION: IOHIDValueRef IOHIDValueCreateWithBytes ( CFAllocatorRef allocator, IOHIDElementRef element, ulonglong timeStamp, uchar* bytes, CFIndex length ) ;
-FUNCTION: IOHIDValueRef IOHIDValueCreateWithBytesNoCopy ( CFAllocatorRef allocator, IOHIDElementRef element, ulonglong timeStamp, uchar* bytes, CFIndex length ) ;
+FUNCTION: IOHIDValueRef IOHIDValueCreateWithBytes ( CFAllocatorRef allocator, IOHIDElementRef element, ulonglong timeStamp, c-string bytes, CFIndex length ) ;
+FUNCTION: IOHIDValueRef IOHIDValueCreateWithBytesNoCopy ( CFAllocatorRef allocator, IOHIDElementRef element, ulonglong timeStamp, c-string bytes, CFIndex length ) ;
FUNCTION: IOHIDElementRef IOHIDValueGetElement ( IOHIDValueRef value ) ;
FUNCTION: ulonglong IOHIDValueGetTimeStamp ( IOHIDValueRef value ) ;
FUNCTION: CFIndex IOHIDValueGetLength ( IOHIDValueRef value ) ;
FUNCTION: IOReturn IOMasterPort ( mach_port_t bootstrap, mach_port_t* master ) ;
-FUNCTION: CFDictionaryRef IOServiceMatching ( char* name ) ;
-FUNCTION: CFDictionaryRef IOServiceNameMatching ( char* name ) ;
-FUNCTION: CFDictionaryRef IOBSDNameMatching ( char* name ) ;
+FUNCTION: CFDictionaryRef IOServiceMatching ( c-string name ) ;
+FUNCTION: CFDictionaryRef IOServiceNameMatching ( c-string name ) ;
+FUNCTION: CFDictionaryRef IOBSDNameMatching ( c-string name ) ;
FUNCTION: IOReturn IOObjectRetain ( io_object_t o ) ;
FUNCTION: IOReturn IOObjectRelease ( io_object_t o ) ;
FUNCTION: IOReturn IORegistryEntryCreateCFProperties ( io_registry_entry_t entry, CFMutableDictionaryRef properties, CFAllocatorRef allocator, IOOptionBits options ) ;
-FUNCTION: char* mach_error_string ( IOReturn error ) ;
+FUNCTION: c-string mach_error_string ( IOReturn error ) ;
TUPLE: mach-error error-code error-string ;
: <mach-error> ( code -- error )
memcmp 0 = ;
: strlen ( alien -- len )
- size_t "libc" "strlen" { char* } alien-invoke ;
+ size_t "libc" "strlen" { c-string } alien-invoke ;
DESTRUCTOR: free
-USING: help.markup help.syntax kernel io system prettyprint continuations quotations ;
+USING: help.markup help.syntax kernel io system prettyprint
+continuations quotations vocabs.loader parser ;
IN: listener
ARTICLE: "listener-watch" "Watching variables in the listener"
-"The listener prints the concepts of the data and retain stacks after every expression. It can also print values of dynamic variables which are added to a watch list:"
+"The listener prints values of dynamic variables which are added to a watch list:"
{ $subsections visible-vars }
"To add or remove a single variable:"
{ $subsections
show-vars
hide-vars
}
-"Hiding all visible variables:"
+"Clearing the watch list:"
{ $subsections hide-all-vars } ;
HELP: only-use-vocabs
{ $description "Removes all variables from the watch list." } ;
ARTICLE: "listener" "The listener"
-"The listener evaluates Factor expressions read from a stream. The listener is the primary interface to the Factor runtime. Typically, you write Factor code in a text editor, then load it using the listener and test it."
+"The listener evaluates Factor expressions read from the input stream. Typically, you write Factor code in a text editor, load it from the listener by calling " { $link require } ", " { $link reload } " or " { $link run-file } ", and then test it from interactively."
$nl
"The classical first program can be run in the listener:"
{ $example "\"Hello, world\" print" "Hello, world" }
+"New words can also be defined in the listener:"
+{ $example
+ "USE: math.functions"
+ ": twice ( word -- ) [ execute ] [ execute ] bi ; inline"
+ "81 \\ sqrt twice ."
+ "3.0"
+}
"Multi-line expressions are supported:"
{ $example "{ 1 2 3 } [\n .\n] each" "1\n2\n3" }
-"The listener knows when to expect more input by looking at the height of the stack. Parsing words such as " { $link POSTPONE: { } " leave elements on the parser stack, and corresponding words such as " { $link POSTPONE: } } " pop them."
+"The listener will display the current contents of the datastack after every line of input."
$nl
-"The listener will display the current contents of the datastack after every expression is evaluated. The listener can additionally watch dynamic variables:"
+"The listener can watch dynamic variables:"
{ $subsections "listener-watch" }
-"To start a nested listener:"
+"Nested listeners can be useful for testing code in other dynamic scopes. For example, when doing database maintanance using the " { $vocab-link "db.tuples" } " vocabulary, it can be useful to start a listener with a database connection:"
+{ $code
+ "USING: db db.sqlite listener ;"
+ "\"data.db\" <sqlite-db> [ listener ] with-db"
+}
+"Starting a nested listener:"
{ $subsections listener }
"To exit a listener, invoke the " { $link return } " word."
$nl
-"Multi-line quotations can be read independently of the rest of the listener:"
+"The listener's mechanism for reading multi-line expressions from the input stream can be called from user code:"
{ $subsections read-quot } ;
ABOUT: "listener"
{ $description "Get the cartesian product of the lists in " { $snippet "list" } " and call " { $snippet "quot" } " call with each element from the cartesian product on the stack, the result of which is returned in the final " { $snippet "list" } "." } ;
HELP: lcomp*
-{ $values { "list" "a list of lists" } { "guards" "a sequence of quotations with stack effect ( seq -- bool )" } { "quot" { $quotation "( seq -- X )" } } { "list" "the resulting list" } { "result" "a list" } }
+{ $values { "list" "a list of lists" } { "guards" "a sequence of quotations with stack effect ( seq -- bool )" } { "quot" { $quotation "( seq -- X )" } } { "result" "a list" } }
{ $description "Get the cartesian product of the lists in " { $snippet "list" } ", filter it by applying each guard quotation to it and call " { $snippet "quot" } " call with each element from the remaining cartesian product items on the stack, the result of which is returned in the final " { $snippet "list" } "." }
{ $examples
{ $code "{ 1 2 3 } >list { 4 5 6 } >list 2list { [ first odd? ] } [ first2 + ] lcomp*" }
! Copyright (C) 2007, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: parser kernel sequences words effects combinators assocs
-definitions quotations namespaces memoize accessors fry
-compiler.units ;
+USING: parser effects.parser kernel sequences words effects
+combinators assocs definitions quotations namespaces memoize
+accessors fry compiler.units ;
IN: macros
<PRIVATE
HELP: bitroll-32
{ $values
- { "n" integer } { "s" integer }
- { "n'" integer }
+ { "m" integer } { "s" integer }
+ { "n" integer }
}
-{ $description "Rolls the number " { $snippet "n" } " by " { $snippet "s" } " bits to the left, wrapping around after 32 bits." }
+{ $description "Rolls the number " { $snippet "m" } " by " { $snippet "s" } " bits to the left, wrapping around after 32 bits." }
{ $examples
{ $example "USING: math.bitwise prettyprint ;"
"HEX: 1 10 bitroll-32 .h"
HELP: bitroll-64
{ $values
- { "n" integer } { "s" "a shift integer" }
- { "n'" integer }
+ { "m" integer } { "s" "a shift integer" }
+ { "n" integer }
}
-{ $description "Rolls the number " { $snippet "n" } " by " { $snippet "s" } " bits to the left, wrapping around after 64 bits." }
+{ $description "Rolls the number " { $snippet "m" } " by " { $snippet "s" } " bits to the left, wrapping around after 64 bits." }
{ $examples
{ $example "USING: math.bitwise prettyprint ;"
"HEX: 1 10 bitroll-64 .h"
HELP: on-bits
{ $values
- { "n" integer }
{ "m" integer }
+ { "n" integer }
}
-{ $description "Returns an integer with " { $snippet "n" } " bits set." }
+{ $description "Returns an integer with " { $snippet "m" } " bits set." }
{ $examples
{ $example "USING: math.bitwise kernel prettyprint ;"
"6 on-bits .h"
HELP: shift-mod
{ $values
- { "n" integer } { "s" integer } { "w" integer }
+ { "m" integer } { "s" integer } { "w" integer }
{ "n" integer }
}
{ $description "Calls " { $link shift } " on " { $snippet "n" } " and " { $snippet "s" } ", wrapping the result to " { $snippet "w" } " bits." } ;
HELP: w*
{ $values
- { "int" integer } { "int" integer }
- { "int" integer }
+ { "x" integer } { "y" integer }
+ { "z" integer }
}
{ $description "Multiplies two integers and wraps the result to 32 bits." }
{ $examples
HELP: w+
{ $values
- { "int" integer } { "int" integer }
- { "int" integer }
+ { "x" integer } { "y" integer }
+ { "z" integer }
}
{ $description "Adds two integers and wraps the result to 32 bits." }
{ $examples
HELP: w-
{ $values
- { "int" integer } { "int" integer }
- { "int" integer }
+ { "x" integer } { "y" integer }
+ { "z" integer }
}
{ $description "Subtracts two integers and wraps the result to 32 bits." }
{ $examples
: wrap ( m n -- m' ) 1 - bitand ; inline
: bits ( m n -- m' ) 2^ wrap ; inline
: mask-bit ( m n -- m' ) 2^ mask ; inline
-: on-bits ( n -- m ) 2^ 1 - ; inline
+: on-bits ( m -- n ) 2^ 1 - ; inline
: toggle-bit ( m n -- m' ) 2^ bitxor ; inline
-
-: shift-mod ( n s w -- n )
- [ shift ] dip 2^ wrap ; inline
+: >signed ( x n -- y ) 2dup neg 1 + shift 1 = [ 2^ - ] [ drop ] if ;
+: >odd ( m -- n ) 0 set-bit ; foldable
+: >even ( m -- n ) 0 clear-bit ; foldable
+: next-even ( m -- n ) >even 2 + ; foldable
+: next-odd ( m -- n ) dup even? [ 1 + ] [ 2 + ] if ; foldable
+: shift-mod ( m s w -- n ) [ shift ] dip 2^ wrap ; inline
: bitroll ( x s w -- y )
[ wrap ] keep
[ shift-mod ] [ [ - ] keep shift-mod ] 3bi bitor ; inline
-: bitroll-32 ( n s -- n' ) 32 bitroll ; inline
+: bitroll-32 ( m s -- n ) 32 bitroll ; inline
-: bitroll-64 ( n s -- n' ) 64 bitroll ; inline
+: bitroll-64 ( m s -- n ) 64 bitroll ; inline
! 32-bit arithmetic
-: w+ ( int int -- int ) + 32 bits ; inline
-: w- ( int int -- int ) - 32 bits ; inline
-: w* ( int int -- int ) * 32 bits ; inline
+: w+ ( x y -- z ) + 32 bits ; inline
+: w- ( x y -- z ) - 32 bits ; inline
+: w* ( x y -- z ) * 32 bits ; inline
! 64-bit arithmetic
-: W+ ( int int -- int ) + 64 bits ; inline
-: W- ( int int -- int ) - 64 bits ; inline
-: W* ( int int -- int ) * 64 bits ; inline
+: W+ ( x y -- z ) + 64 bits ; inline
+: W- ( x y -- z ) - 64 bits ; inline
+: W* ( x y -- z ) * 64 bits ; inline
! flags
MACRO: flags ( values -- )
byte-array-bit-count ;
M: object bit-count
- [ >c-ptr ] [ byte-length ] bi <direct-uchar-array>
- byte-array-bit-count ;
-
-: >signed ( x n -- y )
- 2dup neg 1 + shift 1 = [ 2^ - ] [ drop ] if ;
-
-: >odd ( n -- int ) 0 set-bit ; foldable
-
-: >even ( n -- int ) 0 clear-bit ; foldable
-
-: next-even ( m -- n ) >even 2 + ; foldable
-
-: next-odd ( m -- n ) dup even? [ 1 + ] [ 2 + ] if ; foldable
+ binary-object <direct-uchar-array> byte-array-bit-count ;
: even-parity? ( obj -- ? ) bit-count even? ;
{ $subsections
blas-library
blas-fortran-abi
+ deploy-blas?
}
"The interface attempts to set default values based on the ones encountered on the Factor project's build machines. If these settings don't work with your system's BLAS, or you wish to use a commercial BLAS, you may change the global values of those variables in your " { $link "factor-rc" } ". For example, to use AMD's ACML library on Windows with " { $snippet "math.blas" } ", your " { $snippet "factor-rc" } " would look like this:"
{ $code """
USING: math.blas.config namespaces ;
"X:\\path\\to\\acml.dll" blas-library set-global
intel-windows-abi blas-fortran-abi set-global
+t deploy-blas? set-global
""" }
"To take effect, the " { $snippet "blas-library" } " and " { $snippet "blas-fortran-abi" } " variables must be set before any other " { $snippet "math.blas" } " vocabularies are loaded."
;
HELP: blas-library
-{ $description "The name of the shared library containing the BLAS interface to load. The value of this variable must be a valid shared library name that can be passed to " { $link add-fortran-library } ". To take effect, this variable must be set before any other " { $snippet "math.blas" } " vocabularies are loaded. See " { $link "math.blas.config" } " for details and examples." } ;
+{ $var-description "The name of the shared library containing the BLAS interface to load. The value of this variable must be a valid shared library name that can be passed to " { $link add-fortran-library } ". To take effect, this variable must be set before any other " { $snippet "math.blas" } " vocabularies are loaded. See " { $link "math.blas.config" } " for details and examples." } ;
HELP: blas-fortran-abi
-{ $description "The Fortran ABI used by the BLAS interface specified in the " { $link blas-library } " variable. The value of " { $snippet "blas-fortran-abi" } " must be one of the " { $link "alien.fortran-abis" } " that can be passed to " { $link add-fortran-library } ". To take effect, this variable must be set before any other " { $snippet "math.blas" } " vocabularies are loaded. See " { $link "math.blas.config" } " for details and examples." } ;
+{ $var-description "The Fortran ABI used by the BLAS interface specified in the " { $link blas-library } " variable. The value of " { $snippet "blas-fortran-abi" } " must be one of the " { $link "alien.fortran-abis" } " that can be passed to " { $link add-fortran-library } ". To take effect, this variable must be set before any other " { $snippet "math.blas" } " vocabularies are loaded. See " { $link "math.blas.config" } " for details and examples." } ;
+
+HELP: deploy-blas?
+{ $var-description "If set to a true value, the BLAS library will be configured to deploy with applications that use it. To take effect, this variable must be set before any other " { $snippet "math.blas" } " vocabularies are loaded. See " { $link "math.blas.config" } " for details and examples." } ;
ABOUT: "math.blas.config"
USING: alien.fortran combinators kernel namespaces system ;
IN: math.blas.config
-SYMBOLS: blas-library blas-fortran-abi ;
+SYMBOLS: blas-library blas-fortran-abi deploy-blas? ;
blas-library [
{
[ f2c-abi ]
} cond
] initialize
+
+deploy-blas? [ os macosx? not ] initialize
USING: alien.fortran kernel math.blas.config namespaces ;
+FROM: alien.libraries => deploy-library ;
IN: math.blas.ffi
<<
"blas" blas-library blas-fortran-abi [ get ] bi@
add-fortran-library
+
+deploy-blas? get [ "blas" deploy-library ] when
>>
LIBRARY: blas
: define-complex-blas-matrix ( TYPE T -- )
"U" "C" (define-blas-matrix) ;
-"float" "S" define-real-blas-matrix
-"double" "D" define-real-blas-matrix
-"complex-float" "C" define-complex-blas-matrix
-"complex-double" "Z" define-complex-blas-matrix
+float "S" define-real-blas-matrix
+double "D" define-real-blas-matrix
+complex-float "C" define-complex-blas-matrix
+complex-double "Z" define-complex-blas-matrix
>>
[ drop (define-blas-vector) ]
[ (define-complex-blas-vector) ] 3bi ;
-"float" "S" define-real-blas-vector
-"double" "D" define-real-blas-vector
-"complex-float" "C" "S" define-complex-blas-vector
-"complex-double" "Z" "D" define-complex-blas-vector
+float "S" define-real-blas-vector
+double "D" define-real-blas-vector
+complex-float "C" "S" define-complex-blas-vector
+complex-double "Z" "D" define-complex-blas-vector
>>
} ;
HELP: permutation
-{ $values { "n" "a non-negative integer" } { "seq" sequence } { "seq" sequence } }
+{ $values { "n" "a non-negative integer" } { "seq" sequence } { "seq'" sequence } }
{ $description "Outputs the " { $snippet "nth" } " lexicographical permutation of " { $snippet "seq" } "." }
{ $notes "Permutations are 0-based and a bounds error will be thrown if " { $snippet "n" } " is larger than " { $snippet "seq length factorial 1 -" } "." }
{ $examples
} ;
HELP: all-permutations
-{ $values { "seq" sequence } { "seq" sequence } }
+{ $values { "seq" sequence } { "seq'" sequence } }
{ $description "Outputs a sequence containing all permutations of " { $snippet "seq" } " in lexicographical order." }
{ $examples
{ $example "USING: math.combinatorics prettyprint ;"
} ;
HELP: combination
-{ $values { "m" "a non-negative integer" } { "seq" sequence } { "k" "a non-negative integer" } { "seq" sequence } }
+{ $values { "m" "a non-negative integer" } { "seq" sequence } { "k" "a non-negative integer" } { "seq'" sequence } }
{ $description "Outputs the " { $snippet "mth" } " lexicographical combination of " { $snippet "seq" } " choosing " { $snippet "k" } " elements." }
{ $notes "Combinations are 0-based and a bounds error will be thrown if " { $snippet "m" } " is larger than " { $snippet "seq length k nCk" } "." }
{ $examples
} ;
HELP: all-combinations
-{ $values { "seq" sequence } { "k" "a non-negative integer" } { "seq" sequence } }
+{ $values { "seq" sequence } { "k" "a non-negative integer" } { "seq'" sequence } }
{ $description "Outputs a sequence containing all combinations of " { $snippet "seq" } " choosing " { $snippet "k" } " elements, in lexicographical order." }
{ $examples
{ $example "USING: math.combinatorics prettyprint ;"
PRIVATE>
-: permutation ( n seq -- seq )
+: permutation ( n seq -- seq' )
[ permutation-indices ] keep nths ;
-: all-permutations ( seq -- seq )
+: all-permutations ( seq -- seq' )
[ length factorial iota ] keep
'[ _ permutation ] map ;
: map>assoc-combinations ( seq k quot exemplar -- )
[ combinations-quot ] dip map>assoc ; inline
-: combination ( m seq k -- seq )
+: combination ( m seq k -- seq' )
<combo> apply-combination ;
-: all-combinations ( seq k -- seq )
+: all-combinations ( seq k -- seq' )
[ ] combinations-quot map ;
: reduce-combinations ( seq k identity quot -- result )
m.
] unit-test
-[ { 0 0 -1 } ] [ { 1 0 0 } { 0 1 0 } cross ] unit-test
+[ { 0 0 1 } ] [ { 1 0 0 } { 0 1 0 } cross ] unit-test
[ { 1 0 0 } ] [ { 0 1 0 } { 0 0 1 } cross ] unit-test
[ { 0 1 0 } ] [ { 0 0 1 } { 1 0 0 } cross ] unit-test
+[ { 0.0 -0.707 0.707 } ] [ { 1.0 0.0 0.0 } { 0.0 0.707 0.707 } cross ] unit-test
[ { 1 0 0 } ] [ { 1 1 0 } { 1 0 0 } proj ] unit-test
-[ { { { 1 "a" } { 1 "b" } } { { 2 "a" } { 2 "b" } } } ]
-[ { 1 2 } { "a" "b" } cross-zip ] unit-test
-
[ { { 4181 6765 } { 6765 10946 } } ]
[ { { 0 1 } { 1 1 } } 20 m^n ] unit-test
: identity-matrix ( n -- matrix )
#! Make a nxn identity matrix.
- iota dup [ [ = 1 0 ? ] with map ] curry map ;
+ iota dup [ = 1 0 ? ] cartesian-map ;
:: rotation-matrix3 ( axis theta -- matrix )
theta cos :> c
: mnorm ( m -- n ) dup mmax abs m/n ;
: cross ( vec1 vec2 -- vec3 )
- [ [ { 1 2 1 } vshuffle ] [ { 2 0 0 } vshuffle ] bi* v* ]
- [ [ { 2 0 0 } vshuffle ] [ { 1 2 1 } vshuffle ] bi* v* ] 2bi v- ; inline
+ [ [ { 1 2 0 } vshuffle ] [ { 2 0 1 } vshuffle ] bi* v* ]
+ [ [ { 2 0 1 } vshuffle ] [ { 1 2 0 } vshuffle ] bi* v* ] 2bi v- ; inline
: proj ( v u -- w )
[ [ v. ] [ norm-sq ] bi / ] keep n*v ;
+: perp ( v u -- w )
+ dupd proj v- ;
+
+: angle-between ( v u -- a )
+ [ normalize ] bi@ v. acos ;
+
: (gram-schmidt) ( v seq -- newseq )
[ dupd proj v- ] each ;
: norm-gram-schmidt ( seq -- orthonormal )
gram-schmidt [ normalize ] map ;
-: cross-zip ( seq1 seq2 -- seq1xseq2 )
- [ [ 2array ] with map ] curry map ;
-
: m^n ( m n -- n )
make-bits over first length identity-matrix
[ [ dupd m. ] when [ dup m. ] dip ] reduce nip ;
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 } { 0 1 0 } p= ." "t" } } ;
HELP: ptrim
-{ $values { "p" "a polynomial" } { "p" "a polynomial" } }
+{ $values { "p" "a polynomial" } { "q" "a polynomial" } }
{ $description "Trims excess zeros from a polynomial." }
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 0 0 } ptrim ." "{ 0 1 }" } } ;
HELP: 2ptrim
-{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } }
+{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "p'" "a polynomial" } { "q'" "a polynomial" } }
{ $description "Trims excess zeros from two polynomials." }
{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 0 1 0 0 } { 1 0 0 } 2ptrim [ . ] bi@" "{ 0 1 }\n{ 1 }" } } ;
{ $examples { $example "USING: math.polynomials prettyprint ;" "4 { 3 0 1 } n*p ." "{ 12 0 4 }" } } ;
HELP: pextend-conv
-{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } }
+{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "p'" "a polynomial" } { "q'" "a polynomial" } }
{ $description "Convulution, extending to " { $snippet "p_m + q_n - 1" } "." }
{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } pextend-conv [ . ] bi@" "V{ 1 0 1 0 }\nV{ 0 1 0 0 }" } } ;
: p= ( p q -- ? ) pextend = ;
-: ptrim ( p -- p )
+: ptrim ( p -- q )
dup length 1 = [ [ zero? ] trim-tail ] unless ;
-: 2ptrim ( p q -- p q ) [ ptrim ] bi@ ;
+: 2ptrim ( p q -- p' q' ) [ ptrim ] bi@ ;
: p+ ( p q -- r ) pextend v+ ;
: p- ( p q -- r ) pextend v- ;
: n*p ( n p -- n*p ) n*v ;
-: pextend-conv ( p q -- p q )
+: pextend-conv ( p q -- p' q' )
2dup [ length ] bi@ + 1 - 2pad-tail [ >vector ] bi@ ;
: p* ( p q -- r )
{ $examples { $example "USING: math.quaternions prettyprint ;" "{ 0 0 0 1 } { 0 0 1 0 } q/ ." "{ 0 1 0 0 }" } } ;
HELP: q*n
-{ $values { "q" "a quaternion" } { "n" real } { "q" "a quaternion" } }
+{ $values { "q" "a quaternion" } { "n" real } { "r" "a quaternion" } }
{ $description "Multiplies each element of " { $snippet "q" } " by real value " { $snippet "n" } "." }
{ $notes "To multiply a quaternion with a complex value, use " { $link c>q } " " { $link q* } "." } ;
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2010 Joe Groff, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays combinators kernel locals math math.functions
math.libm math.order math.vectors sequences ;
: q/ ( u v -- u/v )
qrecip q* ; inline
-: n*q ( q n -- q )
+: n*q ( q n -- r )
v*n ; inline
-: q*n ( q n -- q )
+: q*n ( q n -- r )
v*n ; inline
: n>q ( n -- q )
HELP: histogram!
{ $values
{ "hashtable" hashtable } { "seq" sequence }
- { "hashtable" hashtable }
}
{ $examples
{ $example "! Count the number of times the elements of two sequences appear."
HELP: sequence>assoc!
{ $values
{ "assoc" assoc } { "seq" sequence } { "quot" quotation }
- { "assoc" assoc }
}
{ $examples
{ $example "! Iterate over a sequence and add the counts to an existing assoc"
! (c)Joe Groff bsd license
-USING: accessors alien.c-types arrays assocs classes combinators
-combinators.short-circuit fry kernel locals math
-math.vectors math.vectors.simd math.vectors.simd.intrinsics sequences ;
+USING: accessors alien arrays assocs classes combinators
+combinators.short-circuit fry kernel locals math math.vectors
+math.vectors.simd math.vectors.simd.intrinsics sequences ;
FROM: alien.c-types =>
char uchar short ushort int uint longlong ulonglong
- float double ;
+ float double heap-size ;
IN: math.vectors.conversion
ERROR: bad-vconvert from-type to-type ;
$nl
"SIMD support in the processor takes the form of instruction sets which operate on vector registers. By operating on multiple scalar values at the same time, code which operates on points, colors, and other vector data can be sped up."
$nl
-"In Factor, SIMD support is exposed in the form of special-purpose SIMD " { $link "sequence-protocol" } " implementations. These are fixed-length, homogeneous sequences. They are referred to as vectors, but should not be confused with Factor's " { $link "vectors" } ", which can hold any type of object and can be resized.)."
+"In Factor, SIMD support is exposed in the form of special-purpose SIMD " { $link "sequence-protocol" } " implementations. These are fixed-length, homogeneous sequences. They are referred to as vectors, but should not be confused with Factor's " { $link "vectors" } ", which can hold any type of object and can be resized."
$nl
"The words in the " { $vocab-link "math.vectors" } " vocabulary, which can be used with any sequence of numbers, are special-cased by the compiler. If the compiler can prove that only SIMD vectors are used, it expands " { $link "math-vectors" } " into " { $link "math.vectors.simd.intrinsics" } ". While in the general case, SIMD intrinsics operate on heap-allocated SIMD vectors, that too can be optimized since in many cases the compiler unbox SIMD vectors, storing them directly in registers."
$nl
ARTICLE: "math.vectors.simd.types" "SIMD vector types"
"Each SIMD vector type is named " { $snippet "scalar-count" } ", where " { $snippet "scalar" } " is a scalar C type and " { $snippet "count" } " is a vector dimension."
$nl
-"The following vector types are available:"
+"The following 128-bit vector types are defined in the " { $vocab-link "math.vectors.simd" } " vocabulary:"
{ $code
"char-16"
"uchar-16"
"ulonglong-2"
"float-4"
"double-2"
+}
+"Double-width 256-bit vector types are defined in the " { $vocab-link "math.vectors.simd.cords" } " vocabulary:"
+{ $code
+ "char-32"
+ "uchar-32"
+ "short-16"
+ "ushort-16"
+ "int-8"
+ "uint-8"
+ "longlong-4"
+ "ulonglong-4"
+ "float-8"
+ "double-4"
} ;
ARTICLE: "math.vectors.simd.words" "SIMD vector words"
"""USE: compiler.tree.debugger
M\\ actor advance test-mr mr.""" }
-"An example of a high-performance algorithm that uses SIMD primitives can be found in the " { $vocab-link "benchmark.nbody-simd" } " vocabulary." ;
+"Example of a high-performance algorithms that use SIMD primitives can be found in the following vocabularies:"
+{ $list
+ { $vocab-link "benchmark.nbody-simd" }
+ { $vocab-link "benchmark.raytracer-simd" }
+ { $vocab-link "random.sfmt" }
+} ;
ARTICLE: "math.vectors.simd.intrinsics" "Low-level SIMD primitives"
"The words in the " { $vocab-link "math.vectors.simd.intrinsics" } " vocabulary are used to implement SIMD support. These words have three disadvantages compared to the higher-level " { $link "math-vectors" } " words:"
-USING: accessors alien.c-types arrays byte-arrays classes combinators
+USING: accessors alien arrays byte-arrays classes combinators
cpu.architecture effects fry functors generalizations generic
generic.parser kernel lexer literals macros math math.functions
-math.vectors math.vectors.private math.vectors.simd.intrinsics namespaces parser
-prettyprint.custom quotations sequences sequences.private vocabs
-vocabs.loader words ;
+math.vectors math.vectors.private math.vectors.simd.intrinsics
+namespaces parser prettyprint.custom quotations sequences
+sequences.private vocabs vocabs.loader words ;
QUALIFIED-WITH: alien.c-types c
IN: math.vectors.simd
M: simd-128 hashcode* underlying>> hashcode* ; inline
M: simd-128 clone [ clone ] change-underlying ; inline
-M: simd-128 c:byte-length drop 16 ; inline
+M: simd-128 byte-length drop 16 ; inline
M: simd-128 new-sequence
2dup length =
ELT [ A-rep rep-component-type ]
N [ A-rep rep-length ]
-COERCER [ ELT c-type-class "coercer" word-prop [ ] or ]
+COERCER [ ELT c:c-type-class "coercer" word-prop [ ] or ]
SET-NTH [ ELT dup c:c-setter c:array-accessor ]
WHERE
-TUPLE: A < simd-128 ;
+TUPLE: A < simd-128 ; final
M: A new-underlying drop \ A boa ; inline
M: A simd-rep drop A-rep ; inline
-! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
+! Copyright (C) 2007, 2010 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel hashtables sequences sequences.private arrays
-words namespaces make parser math assocs effects definitions
-quotations summary accessors fry ;
+words namespaces make parser effects.parser math assocs effects
+definitions quotations summary accessors fry ;
IN: memoize
<PRIVATE
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: math kernel sequences sequences.private byte-arrays
-alien.c-types prettyprint.custom parser accessors ;
+alien prettyprint.custom parser accessors ;
IN: nibble-arrays
TUPLE: nibble-array
SYNTAX: GL-FUNCTION:
gl-function-calling-convention
- scan
+ scan-c-type
scan dup
scan drop "}" parse-tokens swap prefix
gl-function-number
! This file is based on the gl.h that comes with xorg-x11 6.8.2
USING: alien alien.c-types alien.syntax combinators kernel parser
-sequences system words opengl.gl.extensions ;
+sequences system words opengl.gl.extensions io.encodings.ascii ;
FROM: alien.c-types => short ;
IN: opengl.gl
TYPEDEF: float GLclampf
TYPEDEF: double GLdouble
TYPEDEF: double GLclampd
-TYPEDEF: void* GLvoid*
+C-TYPE: GLvoid
+
+TYPEDEF: c-string[ascii] GLstring
! Constants
FUNCTION: GLint glRenderMode ( GLenum mode ) ;
FUNCTION: GLenum glGetError ( ) ;
-FUNCTION: char* glGetString ( GLenum name ) ;
+FUNCTION: GLstring glGetString ( GLenum name ) ;
FUNCTION: void glFinish ( ) ;
FUNCTION: void glFlush ( ) ;
FUNCTION: void glHint ( GLenum target, GLenum mode ) ;
CONSTANT: GL_STENCIL_BACK_WRITEMASK HEX: 8CA5
ALIAS: GL_BLEND_EQUATION_RGB GL_BLEND_EQUATION
-TYPEDEF: char GLchar
-
GL-FUNCTION: void glAttachShader { glAttachObjectARB } ( GLuint program, GLuint shader ) ;
-GL-FUNCTION: void glBindAttribLocation { glBindAttribLocationARB } ( GLuint program, GLuint index, GLchar* name ) ;
+GL-FUNCTION: void glBindAttribLocation { glBindAttribLocationARB } ( GLuint program, GLuint index, GLstring name ) ;
GL-FUNCTION: void glBlendEquationSeparate { glBlendEquationSeparateEXT } ( GLenum modeRGB, GLenum modeAlpha ) ;
GL-FUNCTION: void glCompileShader { glCompileShaderARB } ( GLuint shader ) ;
GL-FUNCTION: GLuint glCreateProgram { glCreateProgramObjectARB } ( ) ;
GL-FUNCTION: void glDisableVertexAttribArray { glDisableVertexAttribArrayARB } ( GLuint index ) ;
GL-FUNCTION: void glDrawBuffers { glDrawBuffersARB glDrawBuffersATI } ( GLsizei n, GLenum* bufs ) ;
GL-FUNCTION: void glEnableVertexAttribArray { glEnableVertexAttribArrayARB } ( GLuint index ) ;
-GL-FUNCTION: void glGetActiveAttrib { glGetActiveAttribARB } ( GLuint program, GLuint index, GLsizei maxLength, GLsizei* length, GLint* size, GLenum* type, GLchar* name ) ;
-GL-FUNCTION: void glGetActiveUniform { glGetActiveUniformARB } ( GLuint program, GLuint index, GLsizei maxLength, GLsizei* length, GLint* size, GLenum* type, GLchar* name ) ;
+GL-FUNCTION: void glGetActiveAttrib { glGetActiveAttribARB } ( GLuint program, GLuint index, GLsizei maxLength, GLsizei* length, GLint* size, GLenum* type, GLstring name ) ;
+GL-FUNCTION: void glGetActiveUniform { glGetActiveUniformARB } ( GLuint program, GLuint index, GLsizei maxLength, GLsizei* length, GLint* size, GLenum* type, GLstring name ) ;
GL-FUNCTION: void glGetAttachedShaders { glGetAttachedObjectsARB } ( GLuint program, GLsizei maxCount, GLsizei* count, GLuint* shaders ) ;
-GL-FUNCTION: GLint glGetAttribLocation { glGetAttribLocationARB } ( GLuint program, GLchar* name ) ;
-GL-FUNCTION: void glGetProgramInfoLog { glGetInfoLogARB } ( GLuint program, GLsizei bufSize, GLsizei* length, GLchar* infoLog ) ;
+GL-FUNCTION: GLint glGetAttribLocation { glGetAttribLocationARB } ( GLuint program, GLstring name ) ;
+GL-FUNCTION: void glGetProgramInfoLog { glGetInfoLogARB } ( GLuint program, GLsizei bufSize, GLsizei* length, GLstring infoLog ) ;
GL-FUNCTION: void glGetProgramiv { glGetObjectParameterivARB } ( GLuint program, GLenum pname, GLint* param ) ;
-GL-FUNCTION: void glGetShaderInfoLog { glGetInfoLogARB } ( GLuint shader, GLsizei bufSize, GLsizei* length, GLchar* infoLog ) ;
-GL-FUNCTION: void glGetShaderSource { glGetShaderSourceARB } ( GLint obj, GLsizei maxLength, GLsizei* length, GLchar* source ) ;
+GL-FUNCTION: void glGetShaderInfoLog { glGetInfoLogARB } ( GLuint shader, GLsizei bufSize, GLsizei* length, GLstring infoLog ) ;
+GL-FUNCTION: void glGetShaderSource { glGetShaderSourceARB } ( GLint obj, GLsizei maxLength, GLsizei* length, GLstring source ) ;
GL-FUNCTION: void glGetShaderiv { glGetObjectParameterivARB } ( GLuint shader, GLenum pname, GLint* param ) ;
-GL-FUNCTION: GLint glGetUniformLocation { glGetUniformLocationARB } ( GLint programObj, GLchar* name ) ;
+GL-FUNCTION: GLint glGetUniformLocation { glGetUniformLocationARB } ( GLint programObj, GLstring name ) ;
GL-FUNCTION: void glGetUniformfv { glGetUniformfvARB } ( GLuint program, GLint location, GLfloat* params ) ;
GL-FUNCTION: void glGetUniformiv { glGetUniformivARB } ( GLuint program, GLint location, GLint* params ) ;
GL-FUNCTION: void glGetVertexAttribPointerv { glGetVertexAttribPointervARB } ( GLuint index, GLenum pname, GLvoid** pointer ) ;
GL-FUNCTION: GLboolean glIsProgram { glIsProgramARB } ( GLuint program ) ;
GL-FUNCTION: GLboolean glIsShader { glIsShaderARB } ( GLuint shader ) ;
GL-FUNCTION: void glLinkProgram { glLinkProgramARB } ( GLuint program ) ;
-GL-FUNCTION: void glShaderSource { glShaderSourceARB } ( GLuint shader, GLsizei count, GLchar** strings, GLint* lengths ) ;
+GL-FUNCTION: void glShaderSource { glShaderSourceARB } ( GLuint shader, GLsizei count, GLstring* strings, GLint* lengths ) ;
GL-FUNCTION: void glStencilFuncSeparate { glStencilFuncSeparateATI } ( GLenum frontfunc, GLenum backfunc, GLint ref, GLuint mask ) ;
GL-FUNCTION: void glStencilMaskSeparate { } ( GLenum face, GLuint mask ) ;
GL-FUNCTION: void glStencilOpSeparate { glStencilOpSeparateATI } ( GLenum face, GLenum sfail, GLenum dpfail, GLenum dppass ) ;
GL-FUNCTION: void glGetUniformuiv { glGetUniformuivEXT } ( GLuint program, GLint location, GLuint* params ) ;
-GL-FUNCTION: void glBindFragDataLocation { glBindFragDataLocationEXT } ( GLuint program, GLuint colorNumber, GLchar* name ) ;
-GL-FUNCTION: GLint glGetFragDataLocation { glGetFragDataLocationEXT } ( GLuint program, GLchar* name ) ;
+GL-FUNCTION: void glBindFragDataLocation { glBindFragDataLocationEXT } ( GLuint program, GLuint colorNumber, GLstring name ) ;
+GL-FUNCTION: GLint glGetFragDataLocation { glGetFragDataLocationEXT } ( GLuint program, GLstring name ) ;
GL-FUNCTION: void glBeginConditionalRender { glBeginConditionalRenderNV } ( GLuint id, GLenum mode ) ;
GL-FUNCTION: void glEndConditionalRender { glEndConditionalRenderNV } ( ) ;
GL-FUNCTION: void glEndTransformFeedback { glEndTransformFeedbackEXT } ( ) ;
GL-FUNCTION: void glTransformFeedbackVaryings { glTransformFeedbackVaryingsEXT } ( GLuint program, GLsizei count,
- GLchar** varyings, GLenum bufferMode ) ;
+ GLstring* varyings, GLenum bufferMode ) ;
GL-FUNCTION: void glGetTransformFeedbackVarying { glGetTransformFeedbackVaryingEXT } ( GLuint program, GLuint index,
GLsizei bufSize, GLsizei* length,
- GLsizei* size, GLenum* type, GLchar* name ) ;
+ GLsizei* size, GLenum* type, GLstring name ) ;
GL-FUNCTION: void glClearBufferiv { } ( GLenum buffer, GLint drawbuffer, GLint* value ) ;
GL-FUNCTION: void glClearBufferuiv { } ( GLenum buffer, GLint drawbuffer, GLuint* value ) ;
GL-FUNCTION: void glTexBuffer { glTexBufferEXT } ( GLenum target, GLenum internalformat, GLuint buffer ) ;
GL-FUNCTION: void glPrimitiveRestartIndex { } ( GLuint index ) ;
-GL-FUNCTION: void glGetUniformIndices { } ( GLuint program, GLsizei uniformCount, GLchar** uniformNames, GLuint* uniformIndices ) ;
+GL-FUNCTION: void glGetUniformIndices { } ( GLuint program, GLsizei uniformCount, GLstring* uniformNames, GLuint* uniformIndices ) ;
GL-FUNCTION: void glGetActiveUniformsiv { } ( GLuint program, GLsizei uniformCount, GLuint* uniformIndices, GLenum pname, GLint* params ) ;
-GL-FUNCTION: void glGetActiveUniformName { } ( GLuint program, GLuint uniformIndex, GLsizei bufSize, GLsizei* length, GLchar* uniformName ) ;
-GL-FUNCTION: GLuint glGetUniformBlockIndex { } ( GLuint program, GLchar* uniformBlockName ) ;
+GL-FUNCTION: void glGetActiveUniformName { } ( GLuint program, GLuint uniformIndex, GLsizei bufSize, GLsizei* length, GLstring uniformName ) ;
+GL-FUNCTION: GLuint glGetUniformBlockIndex { } ( GLuint program, GLstring uniformBlockName ) ;
GL-FUNCTION: void glGetActiveUniformBlockiv { } ( GLuint program, GLuint uniformBlockIndex, GLenum pname, GLint* params ) ;
-GL-FUNCTION: void glGetActiveUniformBlockName { } ( GLuint program, GLuint uniformBlockIndex, GLsizei bufSize, GLsizei* length, GLchar* uniformName ) ;
+GL-FUNCTION: void glGetActiveUniformBlockName { } ( GLuint program, GLuint uniformBlockIndex, GLsizei bufSize, GLsizei* length, GLstring uniformName ) ;
GL-FUNCTION: void glUniformBlockBinding { } ( GLuint buffer, GLuint uniformBlockIndex, GLuint uniformBlockBinding ) ;
GL-FUNCTION: void glCopyBufferSubData { glCopyBufferSubDataEXT } ( GLenum readtarget, GLenum writetarget, GLintptr readoffset, GLintptr writeoffset, GLsizeiptr size ) ;
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
LIBRARY: gl
FUNCTION: HGLRC wglGetCurrentContext ( ) ;
-FUNCTION: void* wglGetProcAddress ( char* name ) ;
+FUNCTION: void* wglGetProcAddress ( c-string name ) ;
: gl-function-context ( -- context ) wglGetCurrentContext ; inline
: gl-function-address ( name -- address ) wglGetProcAddress ; inline
{ $description "Deletes the shader object, invalidating it and releasing any resources allocated for it by the OpenGL implementation." } ;
HELP: gl-shader-info-log
-{ $values { "shader" "A " { $link gl-shader } " object" } { "shader" "a new " { $link gl-shader } } { "log" string } }
+{ $values { "shader" "A " { $link gl-shader } " object" } { "log" string } }
{ $description "Retrieves the info log for " { $snippet "shader" } ", including any errors or warnings generated in compiling the shader object." } ;
HELP: gl-program
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs cache colors.constants destructors
kernel opengl opengl.gl opengl.capabilities combinators images
images.tesselation grouping sequences math math.vectors
-math.matrices generalizations fry arrays namespaces system
+generalizations fry arrays namespaces system
locals literals specialized-arrays ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
: image-locs ( image-grid -- loc-grid )
[ first [ dim>> first ] map ] [ [ first dim>> second ] map ] bi
[ 0 [ + ] accumulate nip ] bi@
- cross-zip flip ;
+ cartesian-product flip ;
: <texture-grid> ( image-grid loc -- grid )
[ dup image-locs ] dip
! bio.h
! ===============================================
-FUNCTION: bio* BIO_new_file ( char* filename, char* mode ) ;
+FUNCTION: bio* BIO_new_file ( c-string filename, c-string mode ) ;
-FUNCTION: int BIO_printf ( bio* bio, char* format ) ;
+FUNCTION: int BIO_printf ( bio* bio, c-string format ) ;
FUNCTION: long BIO_ctrl ( void* bio, int cmd, long larg, void* parg ) ;
FUNCTION: int BIO_read ( void* b, void* buf, int len ) ;
-FUNCTION: int BIO_gets ( void* b, char* buf, int size ) ;
+FUNCTION: int BIO_gets ( void* b, c-string buf, int size ) ;
FUNCTION: int BIO_write ( void* b, void* buf, int len ) ;
-FUNCTION: int BIO_puts ( void* bp, char* buf ) ;
+FUNCTION: int BIO_puts ( void* bp, c-string buf ) ;
FUNCTION: ulong ERR_get_error ( ) ;
FUNCTION: void ERR_clear_error ( ) ;
-FUNCTION: char* ERR_error_string ( ulong e, void* buf ) ;
+FUNCTION: c-string ERR_error_string ( ulong e, void* buf ) ;
FUNCTION: void* BIO_f_buffer ( ) ;
CONSTANT: EVP_MAX_MD_SIZE 64
-TYPEDEF: void* EVP_MD*
+C-TYPE: EVP_MD
C-TYPE: ENGINE
STRUCT: EVP_MD_CTX
! Clean them up before exiting
FUNCTION: void EVP_cleanup ( ) ;
-FUNCTION: EVP_MD* EVP_get_digestbyname ( char* name ) ;
+FUNCTION: EVP_MD* EVP_get_digestbyname ( c-string name ) ;
FUNCTION: void EVP_MD_CTX_init ( EVP_MD* ctx ) ;
! objects.h
! ===============================================
-FUNCTION: int OBJ_sn2nid ( char* s ) ;
+FUNCTION: int OBJ_sn2nid ( c-string s ) ;
! ===============================================
! bn.h
} ;
TYPEDEF: void* ssl-method
-TYPEDEF: void* SSL_CTX*
-TYPEDEF: void* SSL_SESSION*
+C-TYPE: SSL_CTX
+C-TYPE: SSL_SESSION
C-TYPE: SSL
LIBRARY: libssl
! x509.h
! ===============================================
-TYPEDEF: void* X509_NAME*
-
+C-TYPE: X509_NAME
C-TYPE: X509
FUNCTION: int X509_NAME_get_text_by_NID ( X509_NAME* name, int nid, void* buf, int len ) ;
! ssl.h
! ===============================================
-FUNCTION: char* SSL_get_version ( SSL* ssl ) ;
+FUNCTION: c-string SSL_get_version ( SSL* ssl ) ;
! Maps OpenSSL errors to strings
FUNCTION: void SSL_load_error_strings ( ) ;
! Load the certificates and private keys into the SSL_CTX
FUNCTION: int SSL_CTX_use_certificate_chain_file ( SSL_CTX* ctx,
- char* file ) ; ! PEM type
+ c-string file ) ; ! PEM type
FUNCTION: SSL* SSL_new ( SSL_CTX* ctx ) ;
FUNCTION: int SSL_get_shutdown ( SSL* ssl ) ;
-FUNCTION: int SSL_CTX_set_session_id_context ( SSL_CTX* ctx, char* sid_ctx, uint len ) ;
+FUNCTION: int SSL_CTX_set_session_id_context ( SSL_CTX* ctx, c-string sid_ctx, uint len ) ;
FUNCTION: SSL_SESSION* SSL_get1_session ( SSL* ssl ) ;
FUNCTION: void RAND_seed ( void* buf, int num ) ;
-FUNCTION: int SSL_set_cipher_list ( SSL* ssl, char* str ) ;
+FUNCTION: int SSL_set_cipher_list ( SSL* ssl, c-string str ) ;
-FUNCTION: int SSL_use_RSAPrivateKey_file ( SSL* ssl, char* str ) ;
+FUNCTION: int SSL_use_RSAPrivateKey_file ( SSL* ssl, c-string str ) ;
FUNCTION: int SSL_CTX_use_RSAPrivateKey_file ( SSL_CTX* ctx, int type ) ;
FUNCTION: int SSL_use_certificate_file ( SSL* ssl,
- char* str, int type ) ;
+ c-string str, int type ) ;
-FUNCTION: int SSL_CTX_load_verify_locations ( SSL_CTX* ctx, char* CAfile,
- char* CApath ) ;
+FUNCTION: int SSL_CTX_load_verify_locations ( SSL_CTX* ctx, c-string CAfile,
+ c-string CApath ) ;
FUNCTION: int SSL_CTX_set_default_verify_paths ( SSL_CTX* ctx ) ;
FUNCTION: void SSL_CTX_set_client_CA_list ( SSL_CTX* ctx, SSL* list ) ;
-FUNCTION: SSL* SSL_load_client_CA_file ( char* file ) ;
+FUNCTION: SSL* SSL_load_client_CA_file ( c-string file ) ;
! Used to manipulate settings of the SSL_CTX and SSL objects.
! This function should never be called directly
FUNCTION: void SSL_CTX_set_default_passwd_cb_userdata ( SSL_CTX* ctx,
void* u ) ;
-FUNCTION: int SSL_CTX_use_PrivateKey_file ( SSL_CTX* ctx, char* file,
+FUNCTION: int SSL_CTX_use_PrivateKey_file ( SSL_CTX* ctx, c-string file,
int type ) ;
! Sets the maximum depth for the allowed ctx certificate chain verification
DESTRUCTOR: pango_font_description_free
FUNCTION: PangoFontDescription*
-pango_font_description_from_string ( char* str ) ;
+pango_font_description_from_string ( c-string str ) ;
-FUNCTION: char*
+FUNCTION: c-string
pango_font_description_to_string ( PangoFontDescription* desc ) ;
-FUNCTION: char*
+FUNCTION: c-string
pango_font_description_to_filename ( PangoFontDescription* desc ) ;
FUNCTION: void
-pango_font_description_set_family ( PangoFontDescription* desc, char* family ) ;
+pango_font_description_set_family ( PangoFontDescription* desc, c-string family ) ;
FUNCTION: void
pango_font_description_set_style ( PangoFontDescription* desc, PangoStyle style ) ;
FUNCTION: void
pango_font_map_list_families ( PangoFontMap* fontmap, PangoFontFamily*** families, int* n_families ) ;
-FUNCTION: char*
+FUNCTION: c-string
pango_font_family_get_name ( PangoFontFamily* family ) ;
FUNCTION: int
FUNCTION: void
pango_font_family_list_faces ( PangoFontFamily* family, PangoFontFace*** faces, int* n_faces ) ;
-FUNCTION: char*
+FUNCTION: c-string
pango_font_face_get_face_name ( PangoFontFace* face ) ;
FUNCTION: void
pango_layout_get_context ( PangoLayout* layout ) ;
FUNCTION: void
-pango_layout_set_text ( PangoLayout* layout, char* text, int length ) ;
+pango_layout_set_text ( PangoLayout* layout, c-string text, int length ) ;
-FUNCTION: char*
+FUNCTION: c-string
pango_layout_get_text ( PangoLayout* layout ) ;
FUNCTION: void
! Copyright (C) 2007, 2008 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences strings fry namespaces make math assocs
-io vectors arrays math.parser math.order combinators
-classes sets unicode.categories compiler.units parser words
-quotations memoize accessors locals splitting
+io vectors arrays math.parser math.order combinators classes
+sets unicode.categories compiler.units parser effects.parser
+words quotations memoize accessors locals splitting
combinators.short-circuit generalizations ;
IN: peg
USING: help.markup help.syntax io kernel
-prettyprint.sections words ;
+prettyprint.sections words quotations ;
IN: prettyprint.config
ABOUT: "prettyprint-variables"
HELP: c-object-pointers?
{ $var-description "Toggles whether C objects such as structs and direct arrays only print their underlying address. If this flag isn't set, C objects will attempt to print their contents. If a C object points to invalid memory, it will display only its address regardless." } ;
+
+HELP: with-short-limits
+{ $values { "quot" quotation } }
+{ $description "Calls a quotation in a new dynamic scope with prettyprinter limits set to produce a single line of output." } ;
+
+HELP: without-limits
+{ $values { "quot" quotation } }
+{ $description "Calls a quotation in a new dynamic scope with prettyprinter limits set to produce unlimited output." } ;
-! Copyright (C) 2003, 2008 Slava Pestov.
+! Copyright (C) 2003, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays generic assocs io kernel math
-namespaces sequences strings vectors words
-continuations ;
+USING: kernel namespaces ;
IN: prettyprint.config
! Configuration
4 tab-size set-global
64 margin set-global
+15 nesting-limit set-global
+100 length-limit set-global
10 number-base set-global
+string-limit? on
+
+: with-short-limits ( quot -- )
+ [
+ 1 line-limit set
+ 15 length-limit set
+ 2 nesting-limit set
+ string-limit? on
+ boa-tuples? on
+ c-object-pointers? on
+ call
+ ] with-scope ; inline
+
+: without-limits ( quot -- )
+ [
+ nesting-limit off
+ length-limit off
+ line-limit off
+ string-limit? off
+ c-object-pointers? off
+ call
+ ] with-scope ; inline
boa-tuples?
c-object-pointers?
}
-"Note that the " { $link short. } " and " { $link pprint-short } " variables override some of these variables."
-{
- $warning "Treat the global variables as essentially being constants. Only ever rebind them in a nested scope."
- $nl
- "Some of the globals are safe to change, like the tab size and wrap margin. However setting limits globally could break code which uses the prettyprinter as a serialization mechanism."
-} ;
+"The default limits are meant to strike a balance between readability, and not producing too much output when large structures are given. There are two combinators that override the defaults:"
+{ $subsections with-short-limits without-limits }
+"That the " { $link short. } " and " { $link pprint-short } " words wrap calls to " { $link . } " and " { $link pprint } " in " { $link with-short-limits } ". Code that uses the prettyprinter for serialization should use " { $link without-limits } " to avoid producing unreadable output." ;
ARTICLE: "prettyprint-limitations" "Prettyprinter limitations"
"When using the prettyprinter as a serialization mechanism, keep the following points in mind:"
] [
[ \ tuple-with-initial-declared-slot see ] with-string-writer "\n" split
] unit-test
+
+TUPLE: final-tuple ; final
+
+[
+ {
+ "IN: prettyprint.tests"
+ "TUPLE: final-tuple ; final"
+ ""
+ }
+] [
+ [ \ final-tuple see ] with-string-writer "\n" split
+] unit-test
: unparse-use ( obj -- str ) [ pprint-use ] with-string-writer ;
: pprint-short ( obj -- )
- H{
- { line-limit 1 }
- { length-limit 15 }
- { nesting-limit 2 }
- { string-limit? t }
- { boa-tuples? t }
- } clone [ pprint ] bind ;
+ [ pprint ] with-short-limits ;
: unparse-short ( obj -- str )
[ pprint-short ] with-string-writer ;
! Copyright (C) 2004, 2006 Chris Double, Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays effects fry generalizations kernel math
-namespaces parser sequences words ;
+namespaces parser effects.parser sequences words ;
IN: promises
TUPLE: promise quot forced? value ;
HELP: randomize
{ $values
{ "seq" sequence }
- { "seq" sequence }
+ { "randomized" sequence }
}
{ $description "Randomizes a sequence in-place with the Fisher-Yates algorithm and returns the sequence." } ;
[ [ random ] [ 1 - ] bi [ pick exchange ] keep ]
while drop ;
-: randomize ( seq -- seq )
+: randomize ( seq -- randomized )
dup length randomize-n-last ;
ERROR: too-many-samples seq n ;
+++ /dev/null
-unportable
+++ /dev/null
-unportable
{ >roman >ROMAN roman> } related-words
HELP: roman+
-{ $values { "x" string } { "x" string } { "x" string } }
+{ $values { "x" string } { "y" string } { "z" string } }
{ $description "Adds two Roman numerals." }
{ $examples
{ $example "USING: io roman ;"
} ;
HELP: roman-
-{ $values { "x" string } { "x" string } { "x" string } }
+{ $values { "x" string } { "y" string } { "z" string } }
{ $description "Subtracts two Roman numerals." }
{ $examples
{ $example "USING: io roman ;"
{ roman+ roman- } related-words
HELP: roman*
-{ $values { "x" string } { "x" string } { "x" string } }
+{ $values { "x" string } { "y" string } { "z" string } }
{ $description "Multiplies two Roman numerals." }
{ $examples
{ $example "USING: io roman ;"
} ;
HELP: roman/i
-{ $values { "x" string } { "x" string } { "x" string } }
+{ $values { "x" string } { "y" string } { "z" string } }
{ $description "Computes the integer division of two Roman numerals." }
{ $examples
{ $example "USING: io roman ;"
} ;
HELP: roman/mod
-{ $values { "x" string } { "x" string } { "x" string } { "x" string } }
+{ $values { "x" string } { "y" string } { "z" string } { "w" string } }
{ $description "Computes the quotient and remainder of two Roman numerals." }
{ $examples
{ $example "USING: kernel io roman ;"
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs effects fry generalizations
grouping kernel lexer macros math math.order math.vectors
-namespaces parser quotations sequences sequences.private
-splitting.monotonic stack-checker strings unicode.case words ;
+namespaces parser effects.parser quotations sequences
+sequences.private splitting.monotonic stack-checker strings
+unicode.case words ;
IN: roman
<PRIVATE
SYNTAX: ROMAN-OP:
scan-word [ name>> "roman" prepend create-in ] keep
1quotation '[ _ binary-roman-op ]
- dup infer define-declared ;
+ complete-effect define-declared ;
>>
-ROMAN-OP: +
-ROMAN-OP: -
-ROMAN-OP: *
-ROMAN-OP: /i
-ROMAN-OP: /mod
+ROMAN-OP: + ( x y -- z )
+ROMAN-OP: - ( x y -- z )
+ROMAN-OP: * ( x y -- z )
+ROMAN-OP: /i ( x y -- z )
+ROMAN-OP: /mod ( x y -- z w )
SYNTAX: ROMAN: scan roman> suffix! ;
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes classes.builtin
classes.intersection classes.mixin classes.predicate classes.singleton
dup length 1 = [ first ] when
pprint-slot-name ;
+: tuple-declarations. ( class -- )
+ \ final declaration. ;
+
+: superclass. ( class -- )
+ superclass dup tuple eq? [ drop ] [ "<" text pprint-word ] if ;
+
M: tuple-class see-class*
<colon \ TUPLE: pprint-word
- dup pprint-word
- dup superclass tuple eq? [
- "<" text dup superclass pprint-word
- ] unless
- <block "slots" word-prop [ pprint-slot ] each block>
- pprint-; block> ;
+ {
+ [ pprint-word ]
+ [ superclass. ]
+ [ <block "slots" word-prop [ pprint-slot ] each block> pprint-; ]
+ [ tuple-declarations. ]
+ } cleave
+ block> ;
M: word see-class* drop ;
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov, Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs sequences sorting binary-search fry math
math.order arrays classes combinators kernel functors math.functions
MIXIN: cord
TUPLE: generic-cord
- { head read-only } { tail read-only } ;
+ { head read-only } { tail read-only } ; final
INSTANCE: generic-cord cord
M: cord length
WHERE
TUPLE: T-cord
- { head T read-only } { tail T read-only } ;
+ { head T read-only } { tail T read-only } ; final
INSTANCE: T-cord cord
M: T cord-append
{ $description "Creates a sequence of all of the leaf nodes (non-sequence nodes, but including strings and numbers) in the object." } ;
HELP: deep-map!
-{ $values { "obj" object } { "quot" { $quotation "( elt -- newelt )" } } { "obj" object } }
+{ $values { "obj" object } { "quot" { $quotation "( elt -- newelt )" } } }
{ $description "Modifies each sub-node of an object in place, in preorder, and returns that object." }
{ $see-also map! } ;
USING: tools.test kernel serialize io io.streams.byte-array
alien arrays byte-arrays bit-arrays specialized-arrays
sequences math prettyprint parser classes math.constants
-io.encodings.binary random assocs serialize.private alien.c-types ;
+io.encodings.binary random assocs serialize.private alien.c-types
+combinators.short-circuit ;
SPECIALIZED-ARRAY: double
IN: serialize.tests
[ t ] [
100 [
drop
- 40 [ test-serialize-cell ] all-integers?
- 4 [ 40 * test-serialize-cell ] all-integers?
- 4 [ 400 * test-serialize-cell ] all-integers?
- 4 [ 4000 * test-serialize-cell ] all-integers?
- and and and
+ {
+ [ 40 [ test-serialize-cell ] all-integers? ]
+ [ 4 [ 40 * test-serialize-cell ] all-integers? ]
+ [ 4 [ 400 * test-serialize-cell ] all-integers? ]
+ [ 4 [ 4000 * test-serialize-cell ] all-integers? ]
+ } 0&&
] all-integers?
] unit-test
--- /dev/null
+Slava Pestov
--- /dev/null
+USING: help.markup help.syntax strings ;
+IN: simple-tokenizer
+
+HELP: tokenize
+{ $values { "input" string } { "ast" "a sequence of strings" } }
+{ $description
+ "Tokenize a string. Supported syntax:"
+ { $list
+ { { $snippet "foo bar baz" } " - simple tokens" }
+ { { $snippet "foo\\ bar" } " - token with an escaped space"}
+ { { $snippet "\"foo bar\"" } " - quoted token" }
+ }
+} ;
--- /dev/null
+IN: simple-tokenizer.tests
+USING: simple-tokenizer tools.test ;
+
+[ "" tokenize ] must-fail
+[ " " tokenize ] must-fail
+[ V{ "a" } ] [ "a" tokenize ] unit-test
+[ V{ "abc" } ] [ "abc" tokenize ] unit-test
+[ V{ "abc" } ] [ "abc " tokenize ] unit-test
+[ V{ "abc" } ] [ " abc" tokenize ] unit-test
+[ V{ "abc" "def" } ] [ "abc def" tokenize ] unit-test
+[ V{ "abc def" } ] [ "abc\\ def" tokenize ] unit-test
+[ V{ "abc\\" "def" } ] [ "abc\\\\ def" tokenize ] unit-test
+[ V{ "abc\\ def" } ] [ "\"abc\\\\ def\"" tokenize ] unit-test
+[ V{ "abc\\ def" } ] [ " \"abc\\\\ def\"" tokenize ] unit-test
+[ V{ "abc\\ def" "hey" } ] [ "\"abc\\\\ def\" hey" tokenize ] unit-test
+[ V{ "abc def" "hey" } ] [ "\"abc def\" \"hey\"" tokenize ] unit-test
+[ "\"abc def\" \"hey" tokenize ] must-fail
+[ "\"abc def" tokenize ] must-fail
+[ V{ "abc def" "h\"ey" } ] [ "\"abc def\" \"h\\\"ey\" " tokenize ] unit-test
+
+[
+ V{
+ "Hello world.app/Contents/MacOS/hello-ui"
+ "-i=boot.macosx-ppc.image"
+ "-include= math compiler ui"
+ "-deploy-vocab=hello-ui"
+ "-output-image=Hello world.app/Contents/Resources/hello-ui.image"
+ "-no-stack-traces"
+ "-no-user-init"
+ }
+] [
+ "\"Hello world.app/Contents/MacOS/hello-ui\" -i=boot.macosx-ppc.image \"-include= math compiler ui\" -deploy-vocab=hello-ui \"-output-image=Hello world.app/Contents/Resources/hello-ui.image\" -no-stack-traces -no-user-init" tokenize
+] unit-test
--- /dev/null
+! Copyright (C) 2008, 2010 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: peg peg.ebnf arrays sequences strings kernel ;
+IN: simple-tokenizer
+
+EBNF: tokenize
+space = " "
+escaped-char = "\" .:ch => [[ ch ]]
+quoted = '"' (escaped-char | [^"])*:a '"' => [[ a ]]
+unquoted = (escaped-char | [^ "])+
+argument = (quoted | unquoted) => [[ >string ]]
+command = space* (argument:a space* => [[ a ]])+:c !(.) => [[ c ]]
+;EBNF
IN: specialized-arrays.tests
USING: tools.test alien.syntax specialized-arrays
-specialized-arrays.private sequences alien.c-types accessors
+specialized-arrays.private sequences alien accessors
kernel arrays combinators compiler compiler.units classes.struct
combinators.smart compiler.tree.debugger math libc destructors
sequences.private multiline eval words vocabs namespaces
assocs prettyprint alien.data math.vectors definitions
compiler.test ;
-FROM: alien.c-types => float ;
+FROM: alien.c-types => int float bool char float ulonglong ushort uint
+heap-size little-endian? ;
SPECIALIZED-ARRAY: int
SPECIALIZED-ARRAYS: bool ushort char uint float ulonglong ;
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.data alien.parser
assocs byte-arrays classes compiler.units functors kernel lexer
M: bad-byte-array-length summary
drop "Byte array length doesn't divide type width" ;
+ERROR: not-a-byte-array alien ;
+
+M: not-a-byte-array summary
+ drop "Not a byte array" ;
+
: (underlying) ( n c-type -- array )
heap-size * (byte-array) ; inline
TUPLE: A
{ underlying c-ptr read-only }
-{ length array-capacity read-only } ;
+{ length array-capacity read-only } ; final
: <direct-A> ( alien len -- specialized-array ) A boa ; inline
[ \ T heap-size calloc ] keep <direct-A> ; inline
: byte-array>A ( byte-array -- specialized-array )
- >c-ptr dup length \ T heap-size /mod 0 =
- [ drop \ T bad-byte-array-length ] unless
- <direct-A> ; inline
+ >c-ptr dup byte-array? [
+ dup length \ T heap-size /mod 0 =
+ [ <direct-A> ]
+ [ drop \ T bad-byte-array-length ] if
+ ] [ not-a-byte-array ] if ; inline
M: A clone [ underlying>> clone ] [ length>> ] bi <direct-A> ; inline
] [ drop ] 2bi
<direct-A> ; inline
-M: A byte-length length \ T heap-size * ; inline
+M: A element-size drop \ T heap-size ; inline
M: A direct-array-syntax drop \ A@ ;
;FUNCTOR
-GENERIC: (underlying-type) ( c-type -- c-type' )
+GENERIC: underlying-type ( c-type -- c-type' )
-M: string (underlying-type) c-types get at ;
-M: word (underlying-type) "c-type" word-prop ;
-
-: underlying-type ( c-type -- c-type' )
- dup (underlying-type) {
+M: c-type-word underlying-type
+ dup "c-type" word-prop {
{ [ dup not ] [ drop no-c-type ] }
- { [ dup c-type-name? ] [ nip underlying-type ] }
+ { [ dup pointer? ] [ 2drop void* ] }
+ { [ dup c-type-word? ] [ nip underlying-type ] }
[ drop ]
} cond ;
+M: pointer underlying-type
+ drop void* ;
+
: specialized-array-vocab ( c-type -- vocab )
[
"specialized-arrays.instances." %
[ specialized-array-vocab ] [ '[ _ define-array ] ] bi
generate-vocab ;
-M: c-type-name require-c-array define-array-vocab drop ;
-
ERROR: specialized-array-vocab-not-loaded c-type ;
-M: c-type-name c-array-constructor
+M: c-type-word c-array-constructor
underlying-type
dup [ name>> "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
-M: c-type-name c-(array)-constructor
+M: pointer c-array-constructor drop void* c-array-constructor ;
+
+M: c-type-word c-(array)-constructor
underlying-type
dup [ name>> "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
-M: c-type-name c-direct-array-constructor
+M: pointer c-(array)-constructor drop void* c-(array)-constructor ;
+
+M: c-type-word c-direct-array-constructor
underlying-type
dup [ name>> "<direct-" "-array>" surround ] [ specialized-array-vocab ] bi lookup
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
+M: pointer c-direct-array-constructor drop void* c-direct-array-constructor ;
+
SYNTAX: SPECIALIZED-ARRAYS:
";" parse-tokens [ parse-c-type define-array-vocab use-vocab ] each ;
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.parser assocs
-compiler.units functors growable kernel lexer math namespaces parser
-prettyprint.custom sequences specialized-arrays
+USING: accessors alien alien.c-types alien.parser assocs
+compiler.units functors growable kernel lexer math namespaces
+parser prettyprint.custom sequences specialized-arrays
specialized-arrays.private strings vocabs vocabs.parser
vocabs.generated fry make ;
QUALIFIED: vectors.functor
M: V contract 2drop ; inline
-M: V byte-length length \ T heap-size * ; inline
+M: V element-size drop \ T heap-size ; inline
M: V pprint-delims drop \ V{ \ } ;
USING: kernel sequences accessors combinators math namespaces
init sets words assocs alien.libraries alien alien.c-types
cpu.architecture fry stack-checker.backend stack-checker.errors
-stack-checker.visitor ;
+stack-checker.visitor stack-checker.dependencies ;
IN: stack-checker.alien
TUPLE: alien-node-params return parameters abi in-d out-d ;
TUPLE: alien-callback-params < alien-node-params quot xt ;
-: param-prep-quot ( node -- quot )
+: param-prep-quot ( params -- quot )
parameters>> [ c-type c-type-unboxer-quot ] map spread>quot ;
+: infer-params ( params -- )
+ param-prep-quot infer-quot-here ;
+
: alien-stack ( params extra -- )
over parameters>> length + consume-d >>in-d
dup return>> void? 0 1 ? produce-d >>out-d
drop ;
-: return-prep-quot ( node -- quot )
+: return-prep-quot ( params -- quot )
return>> [ [ ] ] [ c-type c-type-boxer-quot ] if-void ;
+: infer-return ( params -- )
+ return-prep-quot infer-quot-here ;
+
+: pop-return ( params -- params )
+ pop-literal [ depends-on-c-type ] [ nip >>return ] bi ;
+
+: pop-library ( params -- params )
+ pop-literal nip >>library ;
+
+: pop-function ( params -- params )
+ pop-literal nip >>function ;
+
+: pop-params ( params -- params )
+ pop-literal [ [ depends-on-c-type ] each ] [ nip >>parameters ] bi ;
+
+: pop-abi ( params -- params )
+ pop-literal nip >>abi ;
+
+: pop-quot ( params -- params )
+ pop-literal nip >>quot ;
+
: infer-alien-invoke ( -- )
alien-invoke-params new
! Compile-time parameters
- pop-literal nip >>parameters
- pop-literal nip >>function
- pop-literal nip >>library
- pop-literal nip >>return
- ! Quotation which coerces parameters to required types
- dup param-prep-quot infer-quot-here
+ pop-params
+ pop-function
+ pop-library
+ pop-return
! Set ABI
- dup library>> library [ abi>> ] [ "cdecl" ] if* >>abi
+ dup library>> library-abi >>abi
+ ! Quotation which coerces parameters to required types
+ dup infer-params
! Magic #: consume exactly the number of inputs
dup 0 alien-stack
! Add node to IR
dup #alien-invoke,
! Quotation which coerces return value to required type
- return-prep-quot infer-quot-here ;
+ infer-return ;
: infer-alien-indirect ( -- )
alien-indirect-params new
! Compile-time parameters
- pop-literal nip >>abi
- pop-literal nip >>parameters
- pop-literal nip >>return
+ pop-abi
+ pop-params
+ pop-return
! Quotation which coerces parameters to required types
- dup param-prep-quot '[ _ dip ] infer-quot-here
+ 1 infer->r
+ dup infer-params
+ 1 infer-r>
! Magic #: consume the function pointer, too
dup 1 alien-stack
! Add node to IR
dup #alien-indirect,
! Quotation which coerces return value to required type
- return-prep-quot infer-quot-here ;
+ infer-return ;
: infer-alien-assembly ( -- )
alien-assembly-params new
! Compile-time parameters
- pop-literal nip >>quot
- pop-literal nip >>abi
- pop-literal nip >>parameters
- pop-literal nip >>return
+ pop-quot
+ pop-abi
+ pop-params
+ pop-return
! Quotation which coerces parameters to required types
- dup param-prep-quot infer-quot-here
+ dup infer-params
! Magic #: consume exactly the number of inputs
dup 0 alien-stack
! Add node to IR
dup #alien-assembly,
! Quotation which coerces return value to required type
- return-prep-quot infer-quot-here ;
+ infer-return ;
: callback-xt ( word return-rewind -- alien )
[ callbacks get ] dip '[ _ <callback> ] cache ;
: infer-alien-callback ( -- )
alien-callback-params new
- pop-literal nip >>quot
- pop-literal nip >>abi
- pop-literal nip >>parameters
- pop-literal nip >>return
+ pop-quot
+ pop-abi
+ pop-params
+ pop-return
"( callback )" <uninterned-word> >>xt
dup callback-bottom
#alien-callback, ;
! Copyright (C) 2009, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: assocs accessors classes.algebra fry generic kernel math
-namespaces sequences words sets combinators.short-circuit ;
+USING: arrays assocs accessors classes classes.algebra fry
+generic kernel math namespaces sequences words sets
+combinators.short-circuit classes.tuple alien.c-types ;
FROM: classes.tuple.private => tuple-layout ;
+FROM: assocs => change-at ;
IN: stack-checker.dependencies
! Words that the current quotation depends on
: depends-on-definition ( word -- )
definition-dependency depends-on ;
+GENERIC: depends-on-c-type ( c-type -- )
+
+M: void depends-on-c-type drop ;
+
+M: c-type-word depends-on-c-type depends-on-definition ;
+
+M: array depends-on-c-type
+ [ word? ] filter [ depends-on-definition ] each ;
+
+M: pointer depends-on-c-type
+ to>> depends-on-c-type ;
+
! Generic words that the current quotation depends on
SYMBOL: generic-dependencies
boa conditional-dependencies get
dup [ conjoin ] [ 2drop ] if ; inline
-TUPLE: depends-on-class<= class1 class2 ;
+TUPLE: depends-on-class-predicate class1 class2 result ;
-: depends-on-class<= ( class1 class2 -- )
- \ depends-on-class<= add-conditional-dependency ;
+: depends-on-class-predicate ( class1 class2 result -- )
+ \ depends-on-class-predicate add-conditional-dependency ;
-M: depends-on-class<= satisfied?
+M: depends-on-class-predicate satisfied?
{
- [ class1>> classoid? ]
- [ class2>> classoid? ]
- [ [ class1>> ] [ class2>> ] bi class<= ]
+ [ [ class1>> classoid? ] [ class2>> classoid? ] bi and ]
+ [ [ [ class1>> ] [ class2>> ] bi compare-classes ] [ result>> ] bi eq? ]
} 1&& ;
-TUPLE: depends-on-classes-disjoint class1 class2 ;
+TUPLE: depends-on-instance-predicate object class result ;
-: depends-on-classes-disjoint ( class1 class2 -- )
- \ depends-on-classes-disjoint add-conditional-dependency ;
+: depends-on-instance-predicate ( object class result -- )
+ \ depends-on-instance-predicate add-conditional-dependency ;
-M: depends-on-classes-disjoint satisfied?
+M: depends-on-instance-predicate satisfied?
{
- [ class1>> classoid? ]
- [ class2>> classoid? ]
- [ [ class1>> ] [ class2>> ] bi classes-intersect? not ]
+ [ class>> classoid? ]
+ [ [ [ object>> ] [ class>> ] bi instance? ] [ result>> ] bi eq? ]
} 1&& ;
TUPLE: depends-on-next-method class generic next-method ;
M: depends-on-flushable satisfied?
word>> flushable? ;
+TUPLE: depends-on-final class ;
+
+: depends-on-final ( word -- )
+ [ depends-on-conditionally ]
+ [ \ depends-on-final add-conditional-dependency ] bi ;
+
+M: depends-on-final satisfied?
+ class>> final-class? ;
+
: init-dependencies ( -- )
H{ } clone dependencies set
H{ } clone generic-dependencies set
} ;
ARTICLE: "inference-errors" "Stack checker errors"
-"These " { $link "inference" } " failure conditions are reported in one of two ways:"
+"Stack effect checking failure conditions are reported in one of two ways:"
{ $list
- { { $link "tools.inference" } " throws them as errors" }
- { "The " { $link "compiler" } " reports them via " { $link "tools.errors" } }
+ { { $link "tools.inference" } " report them when fed quotations interactively" }
+ { "The " { $link "compiler" } " reports them while compiling words, via the " { $link "tools.errors" } " mechanism" }
}
"Errors thrown when insufficient information is available to calculate the stack effect of a call to a combinator or macro (see " { $link "inference-combinators" } "):"
{ $subsections
\ fgetc { alien } { object } define-primitive
-\ fwrite { string alien } { } define-primitive
+\ fwrite { c-ptr integer alien } { } define-primitive
\ fputc { object alien } { } define-primitive
-\ fread { integer string } { object } define-primitive
+\ fread { integer alien } { object } define-primitive
\ fflush { alien } { } define-primitive
-\ fseek { alien integer integer } { } define-primitive
+\ fseek { integer integer alien } { } define-primitive
\ ftell { alien } { integer } define-primitive
tri ;
: atom-entry-link ( tag -- url/f )
- "link" tags-named [ "rel" attr "alternate" = ] find nip
+ "link" tags-named
+ [ "rel" attr { f "alternate" } member? ] find nip
dup [ "href" attr >url ] when ;
: atom1.0-entry ( tag -- entry )
IN: system-info.linux
: (uname) ( buf -- int )
- int f "uname" { char* } alien-invoke ;
+ int f "uname" { c-string } alien-invoke ;
: uname ( -- seq )
65536 <char-array> [ (uname) io-error ] keep
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
! To make UI browser happy
M: vocab uses drop f ;
-GENERIC: crossref-def ( defspec -- )
-
-M: object crossref-def
+: crossref-def ( defspec -- )
dup uses crossref get add-vertex ;
-M: word crossref-def
- [ call-next-method ] [ subwords [ crossref-def ] each ] bi ;
-
: defs-to-crossref ( -- seq )
[
all-words
+ [ [ generic? not ] filter ]
+ [ [ subwords ] map concat ] bi
+
all-articles [ >link ] map
+
source-files get keys [ <pathname> ] map
] append-outputs ;
-! Copyright (C) 2007, 2009 Slava Pestov.
+! Copyright (C) 2007, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces make continuations.private kernel.private init
assocs kernel vocabs words sequences memory io system arrays
io.streams.c io.files io.files.temp io.pathnames io.directories
io.directories.hierarchy io.backend quotations io.launcher
tools.deploy.config tools.deploy.config.editor bootstrap.image
-io.encodings.utf8 destructors accessors hashtables ;
+io.encodings.utf8 destructors accessors hashtables
+tools.deploy.libraries vocabs.metadata.resources ;
IN: tools.deploy.backend
: copy-vm ( executable bundle-name -- vm )
prepend-path vm over copy-file ;
-CONSTANT: theme-path "basis/ui/gadgets/theme/"
+TUPLE: vocab-manifest vocabs libraries ;
-: copy-theme ( name dir -- )
- deploy-ui? get [
- append-path
- theme-path append-path
- [ make-directories ]
- [ theme-path "resource:" prepend swap copy-tree ] bi
- ] [ 2drop ] if ;
+: copy-resources ( manifest name dir -- )
+ append-path swap vocabs>> [ copy-vocab-resources ] with each ;
+
+ERROR: can't-deploy-library-file library ;
+
+: copy-library ( dir library -- )
+ dup find-library-file
+ [ swap over file-name append-path copy-file ]
+ [ can't-deploy-library-file ] ?if ;
+
+: copy-libraries ( manifest name dir -- )
+ append-path swap libraries>> [ copy-library ] with each ;
: image-name ( vocab bundle-name -- str )
prepend-path ".image" append ;
[ "deploy-config-" prepend temp-file ] bi
[ utf8 set-file-contents ] keep ;
-: deploy-command-line ( image vocab config -- flags )
+: deploy-command-line ( image vocab manifest-file config -- flags )
[
bootstrap-profile ?make-staging-image
"-i=" bootstrap-profile staging-image-name append ,
"-resource-path=" "" resource-path append ,
"-run=tools.deploy.shaker" ,
+ "-vocab-manifest-out=" prepend ,
[ "-deploy-vocab=" prepend , ]
[ make-deploy-config "-deploy-config=" prepend , ] bi
"-output-image=" prepend ,
] { } make
] bind ;
-: make-deploy-image ( vm image vocab config -- )
+: parse-vocab-manifest-file ( path -- vocab-manifest )
+ utf8 file-lines
+ dup first "VOCABS:" =
+ [ { "LIBRARIES:" } split1 vocab-manifest boa ]
+ [ "invalid vocab manifest!" throw ] if ;
+
+: make-deploy-image ( vm image vocab config -- manifest )
make-boot-image
- deploy-command-line run-factor ;
+ over "vocab-manifest-" prepend temp-file
+ [ swap deploy-command-line run-factor ]
+ [ parse-vocab-manifest-file ] bi ;
HOOK: deploy* os ( vocab -- )
"Off by default. During normal execution, the word definition quotation of a word compiled with the optimizing compiler is not used, so disabling this flag can save space. However, some libraries introspect word definitions dynamically (for example, " { $vocab-link "inverse" } ") and so programs using these libraries must retain word definition quotations." } ;
HELP: deploy-c-types?
-{ $description "Deploy flag. If set, the deploy tool retains the " { $link c-types } " table, otherwise this table is stripped out, saving space."
+{ $description "Deploy flag. If set, the deploy tool retains word properties containing metadata for C types and struct classes; otherwise, these properties are stripped out, saving space."
$nl
"Off by default."
$nl
{ $link malloc-object }
{ $link malloc-array }
}
-"If your program looks up C types dynamically or from words which do not have a stack effect, you must enable this flag, because in these situations the C type lookup is not folded away and the global table must be consulted at runtime." } ;
+"If your program looks up C types dynamically or from words which do not have a stack effect, you must enable this flag, because in these situations the C type lookup code is not folded away and the word properties must be consulted at runtime." } ;
HELP: deploy-math?
{ $description "Deploy flag. If set, the deployed image will contain support for " { $link ratio } " and " { $link complex } " types."
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: assocs io.pathnames kernel parser prettyprint sequences
-splitting tools.deploy.config vocabs.loader vocabs.metadata ;
+USING: assocs io.pathnames kernel parser prettyprint
+prettyprint.config sequences splitting tools.deploy.config
+vocabs.loader vocabs.metadata ;
IN: tools.deploy.config.editor
: deploy-config-path ( vocab -- string )
parse-fresh [ first assoc-union ] unless-empty ;
: set-deploy-config ( assoc vocab -- )
- [ unparse-use string-lines ] dip
+ [ [ unparse-use ] without-limits string-lines ] dip
dup deploy-config-path set-vocab-file-contents ;
: set-deploy-flag ( value key vocab -- )
{ $subsections
"deploy-config"
"deploy-flags"
+ "deploy-resources"
} ;
+ARTICLE: "deploy-resources" "Deployed resource files"
+"To include additional files in your deployed application, specify their names in a vocabulary's " { $snippet "resources.txt" } " file. The " { $snippet "resources.txt" } " file contains one glob pattern per line. These patterns are expanded relative to the vocabulary directory; files outside of the vocabulary directory cannot be referenced. If a file inside the vocabulary directory matches any of these patterns, it will be included in deployed applications that reference the vocabulary. If a subdirectory matches, its contents will be included recursively."
+$nl
+"If the deployed vocabulary includes an icon file for the current platform, it will be embedded in the deployed application as its GUI icon. See " { $link "vocabs.icons" } "." ;
+
ARTICLE: "tools.deploy.usage" "Deploy tool usage"
"Once the necessary deployment flags have been set, the application can be deployed:"
{ $subsections deploy }
-USING: tools.test system io io.encodings.ascii io.pathnames\r
-io.files io.files.info io.files.temp kernel tools.deploy.config\r
-tools.deploy.config.editor tools.deploy.backend math sequences\r
-io.launcher arrays namespaces continuations layouts accessors\r
-urls math.parser io.directories tools.deploy.test ;\r
-IN: tools.deploy.tests\r
-\r
-[ ] [ "hello-world" shake-and-bake 500000 small-enough? ] unit-test\r
-\r
-[ ] [ "sudoku" shake-and-bake 800000 small-enough? ] unit-test\r
-\r
-[ ] [ "hello-ui" shake-and-bake 1300000 small-enough? ] unit-test\r
-\r
-[ "staging.math-threads-compiler-ui.image" ] [\r
- "hello-ui" deploy-config\r
- [ bootstrap-profile staging-image-name file-name ] bind\r
-] unit-test\r
-\r
-[ ] [ "maze" shake-and-bake 1200000 small-enough? ] unit-test\r
-\r
-[ ] [ "tetris" shake-and-bake 1500000 small-enough? ] unit-test\r
-\r
-[ ] [ "spheres" shake-and-bake 1500000 small-enough? ] unit-test\r
-\r
-[ ] [ "terrain" shake-and-bake 1700000 small-enough? ] unit-test\r
-\r
-[ ] [ "bunny" shake-and-bake 2500000 small-enough? ] unit-test\r
-\r
-os macosx? [\r
- [ ] [ "webkit-demo" shake-and-bake 500000 small-enough? ] unit-test\r
-] when\r
-\r
-[ ] [ "benchmark.regex-dna" shake-and-bake 900000 small-enough? ] unit-test\r
-\r
-{\r
- "tools.deploy.test.1"\r
- "tools.deploy.test.2"\r
- "tools.deploy.test.3"\r
- "tools.deploy.test.4"\r
-} [\r
- [ ] swap [\r
- shake-and-bake\r
- run-temp-image\r
- ] curry unit-test\r
-] each\r
-\r
-USING: http.client http.server http.server.dispatchers\r
-http.server.responses http.server.static io.servers.connection ;\r
-\r
-SINGLETON: quit-responder\r
-\r
-M: quit-responder call-responder*\r
- 2drop stop-this-server "Goodbye" "text/html" <content> ;\r
-\r
-: add-quot-responder ( responder -- responder )\r
- quit-responder "quit" add-responder ;\r
-\r
-: test-httpd ( responder -- )\r
- [\r
- main-responder set\r
- <http-server>\r
- 0 >>insecure\r
- f >>secure\r
- dup start-server*\r
- sockets>> first addr>> port>>\r
- dup number>string "resource:temp/port-number" ascii set-file-contents\r
- ] with-scope\r
- "port" set ;\r
-\r
-[ ] [\r
- <dispatcher>\r
- add-quot-responder\r
- "vocab:http/test" <static> >>default\r
-\r
- test-httpd\r
-] unit-test\r
-\r
-[ ] [\r
- "tools.deploy.test.5" shake-and-bake\r
- run-temp-image\r
-] unit-test\r
-\r
-: add-port ( url -- url' )\r
- >url clone "port" get >>port ;\r
-\r
-[ ] [ "http://localhost/quit" add-port http-get 2drop ] unit-test\r
-\r
-{\r
- "tools.deploy.test.6"\r
- "tools.deploy.test.7"\r
- "tools.deploy.test.9"\r
- "tools.deploy.test.10"\r
- "tools.deploy.test.11"\r
- "tools.deploy.test.12"\r
-} [\r
- [ ] swap [\r
- shake-and-bake\r
- run-temp-image\r
- ] curry unit-test\r
-] each\r
-\r
-os windows? os macosx? or [\r
- [ ] [ "tools.deploy.test.8" shake-and-bake run-temp-image ] unit-test\r
-] when\r
-\r
-os macosx? [\r
- [ ] [ "tools.deploy.test.14" shake-and-bake run-temp-image ] unit-test\r
-] when\r
-\r
-[ { "a" "b" "c" } ] [\r
- "tools.deploy.test.15" shake-and-bake deploy-test-command\r
- { "a" "b" "c" } append\r
- ascii [ lines ] with-process-reader\r
- rest\r
-] unit-test\r
-\r
-[ ] [ "tools.deploy.test.16" shake-and-bake run-temp-image ] unit-test\r
-\r
-[ ] [ "tools.deploy.test.17" shake-and-bake run-temp-image ] unit-test\r
-\r
-[ t ] [\r
- "tools.deploy.test.18" shake-and-bake\r
- deploy-test-command ascii [ readln ] with-process-reader\r
- "test.image" temp-file =\r
-] unit-test\r
+USING: tools.test system io io.encodings.ascii io.pathnames
+io.files io.files.info io.files.temp kernel tools.deploy.config
+tools.deploy.config.editor tools.deploy.backend math sequences
+io.launcher arrays namespaces continuations layouts accessors
+urls math.parser io.directories tools.deploy.test ;
+IN: tools.deploy.tests
+
+[ ] [ "hello-world" shake-and-bake 500000 small-enough? ] unit-test
+
+[ ] [ "sudoku" shake-and-bake 800000 small-enough? ] unit-test
+
+[ ] [ "hello-ui" shake-and-bake 1300000 small-enough? ] unit-test
+
+[ "staging.math-threads-compiler-ui.image" ] [
+ "hello-ui" deploy-config
+ [ bootstrap-profile staging-image-name file-name ] bind
+] unit-test
+
+[ ] [ "maze" shake-and-bake 1200000 small-enough? ] unit-test
+
+[ ] [ "tetris" shake-and-bake 1500000 small-enough? ] unit-test
+
+[ ] [ "spheres" shake-and-bake 1500000 small-enough? ] unit-test
+
+[ ] [ "terrain" shake-and-bake 1700000 small-enough? ] unit-test
+
+[ ] [ "gpu.demos.raytrace" shake-and-bake 2500000 small-enough? ] unit-test
+
+[ ] [ "bunny" shake-and-bake 2500000 small-enough? ] unit-test
+
+[ ] [ "gpu.demos.bunny" shake-and-bake 3500000 small-enough? ] unit-test
+
+os macosx? [
+ [ ] [ "webkit-demo" shake-and-bake 500000 small-enough? ] unit-test
+] when
+
+[ ] [ "benchmark.regex-dna" shake-and-bake 900000 small-enough? ] unit-test
+
+{
+ "tools.deploy.test.1"
+ "tools.deploy.test.2"
+ "tools.deploy.test.3"
+ "tools.deploy.test.4"
+} [
+ [ ] swap [
+ shake-and-bake
+ run-temp-image
+ ] curry unit-test
+] each
+
+USING: http.client http.server http.server.dispatchers
+http.server.responses http.server.static io.servers.connection ;
+
+SINGLETON: quit-responder
+
+M: quit-responder call-responder*
+ 2drop stop-this-server "Goodbye" "text/html" <content> ;
+
+: add-quot-responder ( responder -- responder )
+ quit-responder "quit" add-responder ;
+
+: test-httpd ( responder -- )
+ [
+ main-responder set
+ <http-server>
+ 0 >>insecure
+ f >>secure
+ dup start-server*
+ sockets>> first addr>> port>>
+ dup number>string "resource:temp/port-number" ascii set-file-contents
+ ] with-scope
+ "port" set ;
+
+[ ] [
+ <dispatcher>
+ add-quot-responder
+ "vocab:http/test" <static> >>default
+
+ test-httpd
+] unit-test
+
+[ ] [
+ "tools.deploy.test.5" shake-and-bake
+ run-temp-image
+] unit-test
+
+: add-port ( url -- url' )
+ >url clone "port" get >>port ;
+
+[ ] [ "http://localhost/quit" add-port http-get 2drop ] unit-test
+
+{
+ "tools.deploy.test.6"
+ "tools.deploy.test.7"
+ "tools.deploy.test.9"
+ "tools.deploy.test.10"
+ "tools.deploy.test.11"
+ "tools.deploy.test.12"
+} [
+ [ ] swap [
+ shake-and-bake
+ run-temp-image
+ ] curry unit-test
+] each
+
+os windows? os macosx? or [
+ [ ] [ "tools.deploy.test.8" shake-and-bake run-temp-image ] unit-test
+] when
+
+os macosx? [
+ [ ] [ "tools.deploy.test.14" shake-and-bake run-temp-image ] unit-test
+] when
+
+[ { "a" "b" "c" } ] [
+ "tools.deploy.test.15" shake-and-bake deploy-test-command
+ { "a" "b" "c" } append
+ ascii [ lines ] with-process-reader
+ rest
+] unit-test
+
+[ ] [ "tools.deploy.test.16" shake-and-bake run-temp-image ] unit-test
+
+[ ] [ "tools.deploy.test.17" shake-and-bake run-temp-image ] unit-test
+
+[ t ] [
+ "tools.deploy.test.18" shake-and-bake
+ deploy-test-command ascii [ readln ] with-process-reader
+ "test.image" temp-file =
+] unit-test
--- /dev/null
+! (c)2010 Joe Groff bsd license
+USING: alien.libraries io.pathnames io.pathnames.private kernel
+system vocabs.loader ;
+IN: tools.deploy.libraries
+
+HOOK: find-library-file os ( file -- path )
+
+os windows?
+"tools.deploy.libraries.windows"
+"tools.deploy.libraries.unix" ? require
+
--- /dev/null
+! (c)2010 Joe Groff bsd license
+USING: io.files io.pathnames io.pathnames.private kernel
+sequences system tools.deploy.libraries ;
+IN: tools.deploy.libraries.unix
+
+! stupid hack. better ways to find the library name would be open the library,
+! note a symbol address found in the library, then call dladdr (or use
+: ?exists ( path -- path/f )
+ dup exists? [ drop f ] unless ; inline
+
+M: unix find-library-file
+ dup absolute-path? [ ?exists ] [
+ { "/lib" "/usr/lib" "/usr/local/lib" "/opt/local/lib" "resource:" }
+ [ prepend-path ?exists ] with map-find drop
+ ] if ;
+
--- /dev/null
+! (c)2010 Joe Groff bsd license
+USING: alien.strings byte-arrays io.encodings.utf16n kernel
+specialized-arrays system tools.deploy.libraries windows.kernel32
+windows.types ;
+FROM: alien.c-types => ushort ;
+SPECIALIZED-ARRAY: ushort
+IN: tools.deploy.libraries.windows
+
+M: windows find-library-file
+ f DONT_RESOLVE_DLL_REFERENCES LoadLibraryEx [
+ [
+ 32768 (ushort-array) [ 32768 GetModuleFileName drop ] keep
+ utf16n alien>string
+ ] [ FreeLibrary drop ] bi
+ ] [ f ] if* ;
+
tools.deploy.config.editor assocs hashtables prettyprint
io.backend.unix cocoa io.encodings.utf8 io.backend
cocoa.application cocoa.classes cocoa.plists
-combinators ;
+combinators vocabs.metadata vocabs.loader ;
IN: tools.deploy.macosx
: bundle-dir ( -- dir )
[ bundle-dir prepend-path swap ] keep
"Contents" prepend-path append-path copy-tree ;
-: app-plist ( executable bundle-name -- assoc )
+: app-plist ( icon? executable bundle-name -- assoc )
[
"6.0" "CFBundleInfoDictionaryVersion" set
"APPL" "CFBundlePackageType" set
[ "CFBundleExecutable" set ]
[ "org.factor." prepend "CFBundleIdentifier" set ] bi
+
+ [ "Icon.icns" "CFBundleIconFile" set ] when
] H{ } make-assoc ;
-: create-app-plist ( executable bundle-name -- )
+: create-app-plist ( icon? executable bundle-name -- )
[ app-plist ] keep
"Contents/Info.plist" append-path
write-plist ;
"Resources/English.lproj/MiniFactor.nib" copy-bundle-dir
] [ drop ] if ;
+: copy-icns ( vocab bundle-name -- icon? )
+ swap dup vocab-mac-icon-path vocab-append-path dup exists?
+ [ swap "Contents/Resources/Icon.icns" append-path copy-file t ]
+ [ 2drop f ] if ;
+
: create-app-dir ( vocab bundle-name -- vm )
- [
- nip {
- [ copy-dll ]
- [ copy-nib ]
- [ "Contents/Resources" append-path make-directories ]
- [ "Contents/Resources" copy-theme ]
- } cleave
- ]
- [ create-app-plist ]
- [ "Contents/MacOS/" append-path copy-vm ] 2tri
+ {
+ [
+ nip {
+ [ copy-dll ]
+ [ copy-nib ]
+ [ "Contents/Resources" append-path make-directories ]
+ } cleave
+ ]
+ [ copy-icns ]
+ [ create-app-plist ]
+ [ "Contents/MacOS/" append-path copy-vm ]
+ } 2cleave
dup OCT: 755 set-file-permissions ;
: deploy.app-image ( vocab bundle-name -- str )
[ bundle-name create-app-dir ] keep
[ bundle-name deploy.app-image ] keep
namespace make-deploy-image
+ bundle-name
+ [ "Contents/Resources" copy-resources ]
+ [ "Contents/Frameworks" copy-libraries ] 2bi
bundle-name show-in-finder
] bind
] with-directory ;
! Copyright (C) 2007, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays accessors io.backend io.pathnames io.streams.c
-init fry namespaces math make assocs kernel parser parser.notes
-lexer strings.parser vocabs sequences sequences.deep
+USING: arrays alien.libraries accessors io.backend io.encodings.utf8 io.files
+io.streams.c init fry namespaces math make assocs kernel parser
+parser.notes lexer strings.parser vocabs sequences sequences.deep
sequences.private words memory kernel.private continuations io
vocabs.loader system strings sets vectors quotations byte-arrays
sorting compiler.units definitions generic generic.standard
generic.single tools.deploy.config combinators classes
-classes.builtin slots.private grouping command-line ;
+classes.builtin slots.private grouping command-line io.pathnames ;
QUALIFIED: bootstrap.stage2
QUALIFIED: classes.private
QUALIFIED: compiler.crossref
QUALIFIED: source-files
QUALIFIED: source-files.errors
QUALIFIED: vocabs
+FROM: alien.libraries.private => >deployed-library-path ;
IN: tools.deploy.shaker
! This file is some hairy shit.
run-file
] when ;
+: strip-ui-error-hook ( -- )
+ strip-debugger? deploy-ui? get and "ui" vocab and [
+ "Installing generic UI error hook" show
+ "vocab:tools/deploy/shaker/strip-ui-error-hook.factor"
+ run-file
+ ] when ;
+
: strip-libc ( -- )
"libc" vocab [
"Stripping manual memory management debug code" show
compiler.errors:compiler-errors
continuations:thread-error-hook
} %
-
- deploy-ui? get [
- "ui-error-hook" "ui.gadgets.worlds" lookup ,
- ] when
] when
- deploy-c-types? get [
- "c-types" "alien.c-types" lookup ,
- ] unless
-
"windows-messages" "windows.messages" lookup [ , ] when*
] { } make ;
: startup-stripper ( -- )
t "quiet" set-global
- f output-stream set-global ;
+ f output-stream set-global
+ V{ "resource:" } clone vocab-roots set-global ;
: next-method* ( method -- quot )
[ "method-class" word-prop ]
"Clearing megamorphic caches" show
[ clear-megamorphic-cache ] each ;
-: strip ( -- )
+: write-vocab-manifest ( vocab-manifest-out -- )
+ "Writing vocabulary manifest to " write dup print flush
+ vocabs "VOCABS:" prefix
+ deploy-libraries get [ libraries get at path>> ] map prune "LIBRARIES:" prefix append
+ swap utf8 set-file-lines ;
+
+: prepare-deploy-libraries ( -- )
+ "Preparing deployed libraries" show
+ deploy-libraries get [
+ libraries get [
+ [ path>> >deployed-library-path ] [ abi>> ] bi <library>
+ ] change-at
+ ] each
+
+ [
+ "deploy-libraries" "alien.libraries" lookup forget
+ "deploy-library" "alien.libraries" lookup forget
+ ">deployed-library-path" "alien.libraries.private" lookup forget
+ ] with-compilation-unit ;
+
+: strip ( vocab-manifest-out -- )
+ [ write-vocab-manifest ] when*
startup-stripper
+ prepare-deploy-libraries
strip-libc
strip-destructors
strip-call
strip-cocoa
strip-debugger
+ strip-ui-error-hook
strip-specialized-arrays
compute-next-methods
strip-startup-hooks
1 exit
] recover ; inline
-: (deploy) ( final-image vocab config -- )
+: (deploy) ( final-image vocab-manifest-out vocab config -- )
#! Does the actual work of a deployment in the slave
#! stage2 image
[
"ui.debugger" require
] when
] unless
- deploy-vocab set
- deploy-vocab get require
- deploy-vocab get vocab-main [
- "Vocabulary has no MAIN: word." print flush 1 exit
- ] unless
+ [ deploy-vocab set ] [ require ] [
+ vocab-main [
+ "Vocabulary has no MAIN: word." print flush 1 exit
+ ] unless
+ ] tri
strip
"Saving final image" show
save-image-and-exit
: do-deploy ( -- )
"output-image" get
+ "vocab-manifest-out" get
"deploy-vocab" get
"Deploying " write dup write "..." print
"deploy-config" get parse-file first
--- /dev/null
+USING: namespaces tools.deploy.config fry sequences system kernel ui ui.gadgets.worlds ;
+
+deploy-name get "Factor" or '[
+ _ " encountered an unhandled error." append
+ "The application will now exit."
+ system-alert die
+] ui-error-hook set-global
+++ /dev/null
-unportable
[ "test.image" temp-file delete-file ] ignore-errors
"resource:" [
[ vm "test.image" temp-file ] dip
- dup deploy-config make-deploy-image
+ dup deploy-config make-deploy-image drop
] with-directory ;
ERROR: image-too-big actual-size max-size ;
IN: tools.deploy.unix
: create-app-dir ( vocab bundle-name -- vm )
- dup "" copy-theme
copy-vm
dup OCT: 755 set-file-permissions ;
[ bundle-name create-app-dir ] keep
[ bundle-name image-name ] keep
namespace make-deploy-image
+ bundle-name "" [ copy-resources ] [ copy-libraries ] 3bi
bundle-name normalize-path [ "Binary deployed to " % % "." % ] "" make print
] bind
- ] with-directory ;
\ No newline at end of file
+ ] with-directory ;
--- /dev/null
+USING: accessors alien alien.c-types arrays classes.struct combinators
+io.backend kernel locals math sequences specialized-arrays
+tools.deploy.windows windows.kernel32 windows.types ;
+IN: tools.deploy.windows.ico
+
+<PRIVATE
+
+STRUCT: ico-header
+ { Reserved WORD }
+ { Type WORD }
+ { ImageCount WORD } ;
+
+STRUCT: ico-directory-entry
+ { Width BYTE }
+ { Height BYTE }
+ { Colors BYTE }
+ { Reserved BYTE }
+ { Planes WORD }
+ { BitsPerPixel WORD }
+ { ImageSize DWORD }
+ { ImageOffset DWORD } ;
+SPECIALIZED-ARRAY: ico-directory-entry
+
+STRUCT: group-directory-entry
+ { Width BYTE }
+ { Height BYTE }
+ { Colors BYTE }
+ { Reserved BYTE }
+ { Planes WORD }
+ { BitsPerPixel WORD }
+ { ImageSize DWORD }
+ { ImageResourceID WORD } ;
+
+: ico>group-directory-entry ( ico i -- group )
+ [ {
+ [ Width>> ] [ Height>> ] [ Colors>> ] [ Reserved>> ]
+ [ Planes>> ] [ BitsPerPixel>> ] [ ImageSize>> ]
+ } cleave ] [ 1 + ] bi* group-directory-entry <struct-boa> >c-ptr ; inline
+
+: ico-icon ( directory-entry bytes -- subbytes )
+ [ [ ImageOffset>> dup ] [ ImageSize>> + ] bi ] dip subseq ; inline
+
+:: ico-group-and-icons ( bytes -- group-bytes icon-bytes )
+ bytes ico-header memory>struct :> header
+
+ ico-header heap-size bytes <displaced-alien>
+ header ImageCount>> <direct-ico-directory-entry-array> :> directory
+
+ directory dup length iota [ ico>group-directory-entry ] { } 2map-as
+ :> group-directory
+ directory [ bytes ico-icon ] { } map-as :> icon-bytes
+
+ header clone >c-ptr group-directory concat append
+ icon-bytes ; inline
+
+PRIVATE>
+
+:: embed-icon-resource ( exe ico-bytes id -- )
+ exe normalize-path 1 BeginUpdateResource :> hUpdate
+ hUpdate [
+ ico-bytes ico-group-and-icons :> ( group icons )
+ hUpdate RT_GROUP_ICON id 0 group dup byte-length
+ UpdateResource drop
+
+ icons [| icon i |
+ hUpdate RT_ICON i 1 + MAKEINTRESOURCE 0 icon dup byte-length
+ UpdateResource drop
+ ] each-index
+
+ hUpdate 0 EndUpdateResource drop
+ ] when ;
+
! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: io io.files io.pathnames io.directories io.encodings.ascii kernel namespaces
+USING: io io.encodings.binary io.files io.pathnames io.directories
+io.encodings.ascii kernel namespaces
sequences locals system splitting tools.deploy.backend
tools.deploy.config tools.deploy.config.editor assocs hashtables
-prettyprint combinators windows.shell32 windows.user32 ;
+prettyprint combinators windows.kernel32 windows.shell32 windows.user32
+alien.c-types vocabs.metadata vocabs.loader tools.deploy.windows.ico
+io.files.windows.nt ;
IN: tools.deploy.windows
+CONSTANT: app-icon-resource-id "APPICON"
+
: copy-dll ( bundle-name -- )
"resource:factor.dll" swap copy-file-into ;
: create-exe-dir ( vocab bundle-name -- vm )
dup copy-dll
- deploy-ui? get [
- [ "" copy-theme ] [ ".exe" copy-vm ] bi
- ] [ ".com" copy-vm ] if ;
+ deploy-ui? get ".exe" ".com" ? copy-vm ;
+
+: open-in-explorer ( dir -- )
+ [ f "open" ] dip absolute-path normalize-separators
+ f f SW_SHOWNORMAL ShellExecute drop ;
+
+: embed-ico ( vm vocab -- )
+ dup vocab-windows-icon-path vocab-append-path dup exists?
+ [ binary file-contents app-icon-resource-id embed-icon-resource ]
+ [ 2drop ] if ;
M: winnt deploy*
"resource:" [
dup deploy-config [
deploy-name get
- [
- [ create-exe-dir ]
+ {
+ [ create-exe-dir dup ]
+ [ drop embed-ico ]
[ image-name ]
- [ drop ]
- 2tri namespace make-deploy-image
- ]
- [ nip open-in-explorer ] 2bi
+ [ drop namespace make-deploy-image ]
+ [ nip "" [ copy-resources ] [ copy-libraries ] 3bi ]
+ [ nip open-in-explorer ]
+ } 2cleave
] bind
] with-directory ;
{ inp_fill uchar }
{ inp_file void* }
{ inp_ctr uchar }
- { inp_buff uchar* }
- { inp_buff_end uchar* }
+ { inp_buff c-string }
+ { inp_buff_end c-string }
{ inp_end uchar }
{ translator void* }
{ insn_offset ulonglong }
FUNCTION: void ud_init ( ud* u ) ;
FUNCTION: void ud_set_mode ( ud* u, uchar mode ) ;
FUNCTION: void ud_set_pc ( ud* u, ulonglong pc ) ;
-FUNCTION: void ud_set_input_buffer ( ud* u, uchar* offset, size_t size ) ;
+FUNCTION: void ud_set_input_buffer ( ud* u, c-string offset, size_t size ) ;
FUNCTION: void ud_set_vendor ( ud* u, uint vendor ) ;
FUNCTION: void ud_set_syntax ( ud* u, void* syntax ) ;
FUNCTION: void ud_input_skip ( ud* u, size_t size ) ;
FUNCTION: int ud_input_end ( ud* u ) ;
FUNCTION: uint ud_decode ( ud* u ) ;
FUNCTION: uint ud_disassemble ( ud* u ) ;
-FUNCTION: char* ud_insn_asm ( ud* u ) ;
+FUNCTION: c-string ud_insn_asm ( ud* u ) ;
FUNCTION: void* ud_insn_ptr ( ud* u ) ;
FUNCTION: ulonglong ud_insn_off ( ud* u ) ;
-FUNCTION: char* ud_insn_hex ( ud* u ) ;
+FUNCTION: c-string ud_insn_hex ( ud* u ) ;
FUNCTION: uint ud_insn_len ( ud* u ) ;
-FUNCTION: char* ud_lookup_mnemonic ( int c ) ;
+FUNCTION: c-string ud_lookup_mnemonic ( int c ) ;
: <ud> ( -- ud )
ud malloc-struct &free
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel strings words vocabs ;
+USING: help.markup help.syntax kernel strings words vocabs sequences ;
IN: tools.scaffold
HELP: developer-name
{ scaffold-help scaffold-undocumented } related-words
+HELP: scaffold-authors
+{ $values
+ { "vocab" "a vocabulary specifier" }
+}
+{ $description "Creates an authors.txt file using the value in " { $link developer-name } ". This word only works if no authors.txt file yet exists." } ;
+
+HELP: scaffold-summary
+{ $values
+ { "vocab" "a vocabulary specifier" } { "summary" string }
+}
+{ $description "Creates a summary.txt file with the given summary. This word only works if no summary.txt file yet exists." } ;
+
+HELP: scaffold-tags
+{ $values
+ { "vocab" "a vocabulary specifier" } { "tags" string }
+}
+{ $description "Creates a tags.txt file with the given tags. This word only works if no tags.txt file yet exists." } ;
+
+HELP: scaffold-tests
+{ $values
+ { "vocab" "a vocabulary specifier" }
+}
+{ $description "Takes an existing vocabulary and creates an empty tests file help for each word. This word only works if no tests file yet exists." } ;
+
HELP: scaffold-vocab
{ $values
{ "vocab-root" "a vocabulary root string" } { "string" string } }
! See http://factorcode.org/license.txt for BSD license.
USING: assocs io.files io.pathnames io.directories
io.encodings.utf8 hashtables kernel namespaces sequences
-vocabs.loader io combinators calendar accessors math.parser
-io.streams.string ui.tools.operations quotations strings arrays
-prettyprint words vocabs sorting sets classes math alien urls
-splitting ascii combinators.short-circuit alarms words.symbol
-system summary ;
+vocabs.loader vocabs.metadata io combinators calendar accessors
+math.parser io.streams.string ui.tools.operations quotations
+strings arrays prettyprint words vocabs sorting sets classes
+math alien urls splitting ascii combinators.short-circuit alarms
+words.symbol system summary ;
IN: tools.scaffold
SYMBOL: developer-name
ERROR: not-a-vocab-root string ;
ERROR: vocab-name-contains-separator path ;
ERROR: vocab-name-contains-dot path ;
-ERROR: no-vocab vocab ;
ERROR: bad-developer-name name ;
M: bad-developer-name summary
: check-root ( string -- string )
dup vocab-root? [ not-a-vocab-root ] unless ;
-: check-vocab ( vocab -- vocab )
- dup find-vocab-root [ no-vocab ] unless ;
-
: check-vocab-root/vocab ( vocab-root string -- vocab-root string )
[ check-root ] [ check-vocab-name ] bi* ;
: vocab-root/vocab/suffix>path ( vocab-root vocab suffix -- path )
[ vocab-root/vocab>path dup file-name append-path ] dip append ;
+: vocab/file>path ( vocab file -- path )
+ [ vocab>path ] dip append-path ;
+
: vocab/suffix>path ( vocab suffix -- path )
[ vocab>path dup file-name append-path ] dip append ;
] with-string-writer ;
: set-scaffold-main-file ( vocab path -- )
- [ main-file-string ] dip utf8 set-file-contents ;
+ [ main-file-string 1array ] dip utf8 set-file-lines ;
: scaffold-main ( vocab-root vocab -- )
[ ".factor" vocab-root/vocab/suffix>path ] keep swap scaffolding? [
2drop
] if ;
-: scaffold-authors ( vocab-root vocab -- )
- developer-name get [
- "authors.txt" vocab-root/vocab/file>path scaffolding? [
- developer-name get swap utf8 set-file-contents
+: scaffold-metadata ( vocab file contents -- )
+ [ ensure-vocab-exists ] 2dip
+ [
+ [ vocab/file>path ] dip 1array swap scaffolding? [
+ utf8 set-file-lines
] [
- drop
+ 2drop
] if
] [
2drop
- ] if ;
+ ] if* ;
: lookup-type ( string -- object/string ? )
"new" ?head drop [ { [ CHAR: ' = ] [ digit? ] } 1|| ] trim-tail
: scaffold-undocumented ( string -- )
[ interesting-words. ] [ link-vocab ] bi ;
+: scaffold-authors ( vocab -- )
+ "authors.txt" developer-name get scaffold-metadata ;
+
+: scaffold-tags ( vocab tags -- )
+ [ "tags.txt" ] dip scaffold-metadata ;
+
+: scaffold-summary ( vocab summary -- )
+ [ "summary.txt" ] dip scaffold-metadata ;
+
+: scaffold-platforms ( vocab platforms -- )
+ [ "platforms.txt" ] dip scaffold-metadata ;
+
: scaffold-vocab ( vocab-root string -- )
{
[ scaffold-directory ]
[ scaffold-main ]
- [ scaffold-authors ]
[ nip require ]
+ [ nip scaffold-authors ]
} 2cleave ;
: scaffold-core ( string -- ) "resource:core" swap scaffold-vocab ;
+++ /dev/null
-unportable
HELP: TUPLE-ARRAY:
{ $syntax "TUPLE-ARRAY: class" }
+{ $values { "class" "a final tuple class" } }
{ $description "Generates a new data type in the current vocabulary named " { $snippet { $emphasis "class" } "-array" } " for holding instances of " { $snippet "class" } ", which must be a tuple class word. Together with the class itself, this also generates words named " { $snippet "<" { $emphasis "class" } "-array>" } " and " { $snippet ">" { $emphasis "class" } "-array" } ", for creating new instances of this tuple array type." } ;
ARTICLE: "tuple-arrays" "Tuple arrays"
-"The " { $vocab-link "tuple-arrays" } " vocabulary implements space-efficient unboxed tuple arrays. Whereas an ordinary array of tuples would consist of pointers to heap-allocated objects, a tuple array stores its elements inline. Calling " { $link nth } " copies an element into a new tuple, and calling " { $link set-nth } " copies an existing tuple's slots into an array."
+"The " { $vocab-link "tuple-arrays" } " vocabulary implements space-efficient unboxed tuple arrays. Whereas an ordinary array of tuples would consist of references to heap-allocated objects, a tuple array stores its elements as values."
$nl
-"Since value semantics differ from reference semantics, it is best to use tuple arrays with tuples where all slots are declared " { $link read-only } "."
+"Calling " { $link nth } " copies an element into a new tuple, and calling " { $link set-nth } " copies an existing tuple's slots into an array."
+$nl
+"Since value semantics are incompatible with inheritance, the base type of a tuple array must be declared " { $link POSTPONE: final } ". A best practice that is not enforced is to have all slots in the tuple declared " { $link read-only } "."
+$nl
+"Tuple arrays do not get updated if tuples are redefined to add or remove slots, so caution should be exercised when doing interactive development on code that uses tuple arrays."
$nl
-"Tuple arrays should not be used with inheritance; storing an instance of a subclass in a tuple array will slice off the subclass slots, and getting the same value out again will yield an instance of the superclass. Also, tuple arrays do not get updated if tuples are redefined to add or remove slots, so caution should be exercised when doing interactive development on code that uses tuple arrays."
{ $subsections POSTPONE: TUPLE-ARRAY: }
"An example:"
{ $example
"USE: tuple-arrays"
"IN: scratchpad"
- "TUPLE: point x y ;"
+ "TUPLE: point x y ; final"
"TUPLE-ARRAY: point"
"{ T{ point f 1 2 } T{ point f 1 3 } T{ point f 2 3 } } >point-array first short."
"T{ point f 1 2 }"
USING: tuple-arrays sequences tools.test namespaces kernel
-math accessors ;
+math accessors classes.tuple eval ;
IN: tuple-arrays.tests
SYMBOL: mat
-TUPLE: foo bar ;
+TUPLE: foo bar ; final
C: <foo> foo
TUPLE-ARRAY: foo
[ T{ foo } ] [ mat get first ] unit-test
[ T{ foo f 1 } ] [ T{ foo f 1 } 0 mat get [ set-nth ] keep first ] unit-test
-TUPLE: baz { bing integer } bong ;
+TUPLE: baz { bing integer } bong ; final
TUPLE-ARRAY: baz
[ 0 ] [ 1 <baz-array> first bing>> ] unit-test
[ f ] [ 1 <baz-array> first bong>> ] unit-test
-TUPLE: broken x ;
+TUPLE: broken x ; final
: broken ( -- ) ;
TUPLE-ARRAY: broken
-[ 100 ] [ 100 <broken-array> length ] unit-test
\ No newline at end of file
+[ 100 ] [ 100 <broken-array> length ] unit-test
+
+! Can't define a tuple array for a non-tuple class
+[ "IN: tuple-arrays.tests USING: tuple-arrays words ; TUPLE-ARRAY: word" eval( -- ) ]
+[ error>> not-a-tuple? ]
+must-fail-with
+
+! Can't define a tuple array for a non-final class
+TUPLE: non-final x ;
+
+[ "IN: tuple-arrays.tests USE: tuple-arrays TUPLE-ARRAY: non-final" eval( -- ) ]
+[ error>> not-final? ]
+must-fail-with
\ No newline at end of file
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays combinators.smart fry functors kernel
kernel.private macros sequences combinators sequences.private
-stack-checker parser math classes.tuple.private ;
+stack-checker parser math classes.tuple classes.tuple.private ;
FROM: inverse => undo ;
IN: tuple-arrays
+ERROR: not-final class ;
+
<PRIVATE
MACRO: boa-unsafe ( class -- quot ) tuple-layout '[ _ <tuple-boa> ] ;
[ tuple-arity iota <reversed> [ '[ [ _ ] dip set-nth-unsafe ] ] map '[ _ cleave ] ]
bi '[ _ dip @ ] ;
+: check-final ( class -- )
+ {
+ { [ dup tuple-class? not ] [ not-a-tuple ] }
+ { [ dup final-class? not ] [ not-final ] }
+ [ drop ]
+ } cond ;
+
PRIVATE>
FUNCTOR: define-tuple-array ( CLASS -- )
WHERE
+CLASS check-final
+
TUPLE: CLASS-array
{ seq array read-only }
{ n array-capacity read-only }
ARTICLE: "typed" "Strongly-typed word definitions"
"The Factor compiler supports advanced compiler optimizations that take advantage of the type information it can glean from source code. The " { $vocab-link "typed" } " vocabulary provides syntax that allows words to provide checked type information about their inputs and outputs and improve the performance of compiled code."
+$nl
+"Parameters and return values of typed words where the type is declared to be a " { $link POSTPONE: final } " tuple class with all slots " { $link read-only } " are passed by value."
{ $subsections
POSTPONE: TYPED:
POSTPONE: TYPED::
+}
+"Defining typed words at run time:"
+{ $subsections
define-typed
+}
+"Errors:"
+{ $subsections
input-mismatch-error
output-mismatch-error
} ;
USING: accessors effects eval kernel layouts math namespaces
-quotations tools.test typed words ;
+quotations tools.test typed words words.symbol
+compiler.tree.debugger prettyprint ;
IN: typed.tests
TYPED: f+ ( a: float b: float -- c: float )
most-positive-fixnum neg 1 - 1quotation
[ most-positive-fixnum 1 fix+ ] unit-test
-TUPLE: tweedle-dee ;
-TUPLE: tweedle-dum ;
+TUPLE: tweedle-dee ; final
+TUPLE: tweedle-dum ; final
TYPED: dee ( x: tweedle-dee -- y )
drop \ tweedle-dee ;
TUPLE: unboxable
{ x fixnum read-only }
- { y fixnum read-only } ;
+ { y fixnum read-only } ; final
TUPLE: unboxable2
{ u unboxable read-only }
- { xy fixnum read-only } ;
+ { xy fixnum read-only } ; final
TYPED: unboxy ( in: unboxable -- out: unboxable2 )
dup [ x>> ] [ y>> ] bi - unboxable2 boa ;
TUPLE: unboxable
{ x fixnum read-only }
{ y fixnum read-only }
- { z float read-only } ;
+ { z float read-only } ; final
""" eval( -- )
"""
[ 1 ] [ no-inputs ] unit-test
TUPLE: unboxable3
- { x read-only } ;
+ { x read-only } ; final
TYPED: no-inputs-unboxable-output ( -- out: unboxable3 )
T{ unboxable3 } ;
[ T{ unboxable3 } ] [ no-inputs-unboxable-output ] unit-test
+[ f ] [ no-inputs-unboxable-output no-inputs-unboxable-output eq? ] unit-test
+
SYMBOL: buh
TYPED: no-outputs ( x: integer -- )
buh set ;
[ T{ unboxable3 } ] [ T{ unboxable3 } no-outputs-unboxable-input buh get ] unit-test
+
+[ f ] [
+ T{ unboxable3 } no-outputs-unboxable-input buh get
+ T{ unboxable3 } no-outputs-unboxable-input buh get
+ eq?
+] unit-test
+
+! Reported by littledan
+TUPLE: superclass { x read-only } ;
+TUPLE: subclass < superclass { y read-only } ; final
+
+TYPED: unbox-fail ( a: superclass -- ? ) subclass? ;
+
+[ t ] [ subclass new unbox-fail ] unit-test
+
+! If a final class becomes non-final, typed words need to be recompiled
+TYPED: recompile-fail ( a: subclass -- ? ) buh get eq? ;
+
+[ f ] [ subclass new [ buh set ] [ recompile-fail ] bi ] unit-test
+
+[ ] [ "IN: typed.tests TUPLE: subclass < superclass { y read-only } ;" eval( -- ) ] unit-test
+
+[ t ] [ subclass new [ buh set ] [ recompile-fail ] bi ] unit-test
+
+! Make sure that foldable and flushable work on typed words
+TYPED: add ( a: integer b: integer -- c: integer ) + ; foldable
+
+[ [ 3 ] ] [ [ 1 2 add ] cleaned-up-tree nodes>quot ] unit-test
+
+TYPED: flush-test ( s: symbol -- ? ) on t ; flushable
+
+: flush-print-1 ( symbol -- ) flush-test drop ;
+: flush-print-2 ( symbol -- ) flush-test . ;
+
+SYMBOL: a-symbol
+
+[ f ] [
+ f a-symbol [
+ a-symbol flush-print-1
+ a-symbol get
+ ] with-variable
+] unit-test
+
+[ t ] [
+ f a-symbol [
+ a-symbol flush-print-2
+ a-symbol get
+ ] with-variable
+] unit-test
USING: accessors arrays classes classes.tuple combinators
combinators.short-circuit definitions effects fry hints
math kernel kernel.private namespaces parser quotations
-sequences slots words locals
+sequences slots words locals effects.parser
locals.parser macros stack-checker.dependencies ;
FROM: classes.tuple.private => tuple-layout ;
IN: typed
ERROR: input-mismatch-error < type-mismatch-error ;
ERROR: output-mismatch-error < type-mismatch-error ;
-PREDICATE: typed-gensym < word "typed-gensym" word-prop ;
-PREDICATE: typed-word < word "typed-word" word-prop ;
+PREDICATE: typed-gensym < word "typed-gensym" word-prop >boolean ;
+PREDICATE: typed-word < word "typed-word" word-prop >boolean ;
<PRIVATE
{
[ all-slots empty? not ]
[ immutable-tuple-class? ]
+ [ final-class? ]
} 1&& ;
! typed inputs
: input-mismatch-quot ( word types -- quot )
[ input-mismatch-error ] 2curry ;
+: depends-on-unboxing ( class -- )
+ [ dup tuple-layout depends-on-tuple-layout ]
+ [ depends-on-final ]
+ bi ;
+
: (unboxer) ( type -- quot )
dup unboxable-tuple-class? [
- dup dup tuple-layout depends-on-tuple-layout
+ dup depends-on-unboxing
all-slots [
[ name>> reader-word 1quotation ]
[ class>> (unboxer) ] bi compose
: (unboxed-types) ( type -- types )
dup unboxable-tuple-class?
[
- dup dup tuple-layout depends-on-tuple-layout
+ dup depends-on-unboxing
all-slots [ class>> (unboxed-types) ] map concat
]
[ 1array ] if ;
: boxer ( type -- quot )
dup unboxable-tuple-class?
[
- dup dup tuple-layout depends-on-tuple-layout
+ dup depends-on-unboxing
[ all-slots [ class>> ] map make-boxer ]
[ [ boa ] curry ]
bi compose
[ effect-in-types unboxed-types [ "in" swap 2array ] map ]
[ effect-out-types unboxed-types [ "out" swap 2array ] map ] bi <effect> ;
-M: typed-gensym stack-effect
- call-next-method unboxed-effect ;
-M: typed-gensym crossref?
- "typed-gensym" word-prop crossref? ;
+M: typed-gensym stack-effect call-next-method unboxed-effect ;
+M: typed-gensym parent-word "typed-gensym" word-prop ;
+M: typed-gensym crossref? parent-word crossref? ;
+M: typed-gensym where parent-word where ;
: define-typed-gensym ( word def effect -- gensym )
[ 2drop <typed-gensym> dup ]
M: cocoa-ui-backend beep ( -- )
NSBeep ;
+M: cocoa-ui-backend system-alert
+ invalidate-run-loop-timers
+ NSAlert -> alloc -> init -> autorelease [
+ {
+ [ swap <NSString> -> setInformativeText: ]
+ [ swap <NSString> -> setMessageText: ]
+ [ "OK" <NSString> -> addButtonWithTitle: drop ]
+ [ -> runModal drop ]
+ } cleave
+ ] [ 2drop ] if*
+ init-thread-timer ;
+
CLASS: {
{ +superclass+ "NSObject" }
{ +name+ "FactorApplicationDelegate" }
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
dup win32-error=0/f
dup GlobalLock dup win32-error=0/f
- swapd byte-array>memory
+ rot binary-object memcpy
dup GlobalUnlock win32-error=0/f
CF_UNICODETEXT swap SetClipboardData win32-error=0/f
] with-clipboard ;
M: windows-ui-backend beep ( -- )
0 MessageBeep drop ;
+M: windows-ui-backend system-alert
+ [ f ] 2dip swap MB_OK MessageBox drop ;
+
: fullscreen-RECT ( hwnd -- RECT )
MONITOR_DEFAULTTONEAREST MonitorFromWindow
MONITORINFOEX <struct>
! Copyright (C) 2005, 2009 Eduardo Cavazos and Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types arrays ascii assocs colors
-classes.struct combinators io.encodings.ascii
-io.encodings.string io.encodings.utf8 kernel literals math
-namespaces sequences strings ui ui.backend ui.clipboards
-ui.event-loop ui.gadgets ui.gadgets.private ui.gadgets.worlds
-ui.gestures ui.pixel-formats ui.pixel-formats.private
-ui.private x11 x11.clipboard x11.constants x11.events x11.glx
-x11.io x11.windows x11.xim x11.xlib environment command-line
-combinators.short-circuit ;
+USING: accessors alien.c-types ascii assocs classes.struct combinators
+combinators.short-circuit command-line environment io.encodings.ascii
+io.encodings.string io.encodings.utf8 kernel literals locals math
+namespaces sequences specialized-arrays.instances.alien.c-types.uchar
+strings ui ui.backend ui.clipboards ui.event-loop ui.gadgets
+ui.gadgets.private ui.gadgets.worlds ui.gestures ui.pixel-formats
+ui.pixel-formats.private ui.private x11 x11.clipboard x11.constants
+x11.events x11.glx x11.io x11.windows x11.xim x11.xlib ;
+FROM: unix.ffi => system ;
IN: ui.backend.x11
SINGLETON: x11-ui-backend
M: x11-ui-backend (make-pixel-format)
[ drop dpy get scr get ] dip
- >glx-visual-int-array glXChooseVisual
- XVisualInfo memory>struct ;
+ >glx-visual-int-array glXChooseVisual ;
M: x11-ui-backend (free-pixel-format)
handle>> XFree ;
M: x11-ui-backend beep ( -- )
dpy get 100 XBell drop ;
+<PRIVATE
+: escape-' ( string -- string' )
+ [ dup CHAR: ' = [ drop "'\\''" ] [ 1string ] if ] { } map-as concat ;
+
+: xmessage ( string -- )
+ escape-' "/usr/X11R6/bin/xmessage '" "'" surround system drop ;
+PRIVATE>
+
+M: x11-ui-backend system-alert
+ "\n\n" glue xmessage ;
+
+: black ( -- xcolor ) 0 0 0 0 0 0 XColor <struct-boa> ; inline
+
+M:: x11-ui-backend (grab-input) ( handle -- )
+ handle window>> :> wnd
+ dpy get :> dpy
+ dpy wnd uchar-array{ 0 0 0 0 0 0 0 0 } 8 8 XCreateBitmapFromData :> pixmap
+ dpy pixmap dup black dup 0 0 XCreatePixmapCursor :> cursor
+
+ dpy wnd 1 NoEventMask GrabModeAsync dup wnd cursor CurrentTime XGrabPointer drop
+
+ dpy cursor XFreeCursor drop
+ dpy pixmap XFreePixmap drop ;
+
+M: x11-ui-backend (ungrab-input)
+ drop dpy get CurrentTime XUngrabPointer drop ;
+
x11-ui-backend ui-backend set-global
[ "DISPLAY" os-env "ui.tools" "listener" ? ]
combinators.smart fry kernel locals math math.rectangles
math.vectors models namespaces opengl opengl.gl quotations
sequences strings ui.commands ui.gadgets ui.gadgets.borders
-ui.gadgets.labels ui.gadgets.packs ui.gadgets.tracks
-ui.gadgets.worlds ui.gestures ui.pens ui.pens.image
-ui.pens.solid ui.pens.tile ;
+ui.gadgets.labels ui.gadgets.packs ui.gadgets.theme
+ui.gadgets.tracks ui.gadgets.worlds ui.gestures ui.pens
+ui.pens.image ui.pens.solid ui.pens.tile ;
FROM: models => change-model ;
IN: ui.gadgets.buttons
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sequences namespaces ui.gadgets.frames
-ui.pens.image ui.gadgets.icons ui.gadgets.grids ;
+ui.pens.image ui.gadgets.icons ui.gadgets.grids ui.gadgets.theme ;
IN: ui.gadgets.corners
CONSTANT: @center { 1 1 }
: make-corners ( class name quot -- corners )
[ [ [ 3 3 ] dip new-frame { 1 1 } >>filled-cell ] dip name ] dip
- with-variable ; inline
\ No newline at end of file
+ with-variable ; inline
{ undo-action com-undo }
{ redo-action com-redo }
{ T{ key-down f f "DELETE" } delete-next-character }
- { T{ key-down f { S+ } "DELETE" } delete-next-character }
{ T{ key-down f f "BACKSPACE" } delete-previous-character }
{ T{ key-down f { S+ } "BACKSPACE" } delete-previous-character }
{ T{ key-down f { C+ } "DELETE" } delete-previous-word }
! Copyright (C) 2006, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel math math.order math.matrices namespaces
-make sequences words io math.vectors ui.gadgets
-ui.baseline-alignment columns accessors strings.tables
-math.rectangles fry ;
+USING: arrays kernel math math.order namespaces make sequences
+words io math.vectors ui.gadgets ui.baseline-alignment columns
+accessors strings.tables math.rectangles fry ;
IN: ui.gadgets.grids
TUPLE: grid < gadget
: (compute-cell-locs) ( grid-layout -- locs )
[ accumulate-cell-xs nip ]
[ accumulate-cell-ys nip ]
- bi cross-zip flip ;
+ bi cartesian-product flip ;
: adjust-for-baseline ( row-locs row-cells -- row-locs' )
align-baselines [ 0 swap 2array v+ ] 2map ;
: cell-dims ( grid-layout -- dims )
dup fill?>>
- [ [ column-widths>> ] [ row-heights>> ] bi cross-zip flip ]
+ [ [ column-widths>> ] [ row-heights>> ] bi cartesian-product flip ]
[ grid>> [ [ pref-dim>> ] map ] map ]
if ;
USING: accessors kernel delegate fry sequences models
combinators.short-circuit models.search models.delay calendar locals
ui.gestures ui.pens ui.pens.image ui.gadgets.editors ui.gadgets.labels
-ui.gadgets.scrollers ui.gadgets.tables ui.gadgets.tracks
+ui.gadgets.scrollers ui.gadgets.tables ui.gadgets.theme ui.gadgets.tracks
ui.gadgets.borders ui.gadgets.buttons ui.baseline-alignment ui.gadgets ;
IN: ui.gadgets.search-tables
M: search-table model-changed
nip field>> clear-search-field ;
-M: search-table focusable-child* field>> ;
\ No newline at end of file
+M: search-table focusable-child* field>> ;
vectors models models.range math.vectors math.functions quotations
colors colors.constants math.rectangles fry combinators ui.gestures
ui.pens ui.gadgets ui.gadgets.buttons ui.gadgets.tracks math.order
-ui.gadgets.icons ui.pens.tile ui.pens.image ;
+ui.gadgets.icons ui.gadgets.theme ui.pens.tile ui.pens.image ;
IN: ui.gadgets.sliders
TUPLE: slider < track elevator thumb saved line ;
! See http://factorcode.org/license.txt for BSD license.
USING: ui.pens ui.gadgets.tracks ui.gadgets.buttons
ui.gadgets.buttons.private ui.gadgets.books ui.gadgets.packs
-ui.gadgets.borders ui.gadgets.icons ui.gadgets ui.pens.image
-sequences models accessors kernel colors colors.constants ;
+ui.gadgets.borders ui.gadgets.icons ui.gadgets ui.gadgets.theme
+ui.pens.image sequences models accessors kernel colors
+colors.constants ;
IN: ui.gadgets.tabbed
TUPLE: tabbed-gadget < track tabs book ;
--- /dev/null
+! (c)2009, 2010 Slava Pestov, Joe Groff bsd license
+USING: io.pathnames sequences ui.images ;
+IN: ui.gadgets.theme
+
+: theme-image ( name -- image-name )
+ "vocab:ui/gadgets/theme/" prepend-path ".tiff" append <image-name> ;
{ $description "Selects an OpenGL context to be the implicit destination for subsequent GL rendering calls. This word is called automatically by the UI before drawing a " { $link world } "." } ;
HELP: window-resource
-{ $values { "resource" disposable } { "resource" disposable } }
+{ $values { "resource" disposable } }
{ $description "Marks " { $snippet "resource" } " to be destroyed with " { $link dispose } " when the window with the currently active OpenGL context (set by " { $link set-gl-context } ") is closed. " { $snippet "resource" } " is left unmodified at the top of the stack." } ;
HELP: flush-gl-context
dup [ draw-world* ] with-gl-context
flush-layout-cache-hook get call( -- )
] [
- over <world-error> ui-error
- f >>active? drop
+ swap f >>active? <world-error> ui-error
] recover
] with-variable
] [ drop ] if ;
bi*
] H{ } assoc-map-as
H{
+ { T{ key-down f { S+ } "DELETE" } [ \ cut-action send-action ] }
+ { T{ key-down f { S+ } "INSERT" } [ \ paste-action send-action ] }
+ { T{ key-down f { C+ } "INSERT" } [ \ copy-action send-action ] }
{ T{ button-down f { C+ } 1 } [ drop T{ button-down f f 3 } button-gesture ] }
{ T{ button-down f { A+ } 1 } [ drop T{ button-down f f 2 } button-gesture ] }
{ T{ button-down f { M+ } 1 } [ drop T{ button-down f f 2 } button-gesture ] }
M: image-pen pen-pref-dim nip image>> image-dim ;
-: theme-image ( name -- image-name )
- "vocab:ui/gadgets/theme/" prepend-path ".tiff" append <image-name> ;
\ No newline at end of file
+++ /dev/null
-unportable
--- /dev/null
+linux
+freebsd
+netbsd
+openbsd
+++ /dev/null
-unportable
+++ /dev/null
-unportable\r
$nl
"Interactors are created by calling " { $link <interactor> } "."
$nl
-"Interactors implement the " { $link stream-readln } ", " { $link stream-read } " and " { $link read-quot } " generic words." } ;
+"Interactors implement the " { $link stream-readln } ", " { $link stream-read } " and " { $link stream-read-quot } " generic words." } ;
ARTICLE: "ui-listener" "UI listener"
"The graphical listener adds input history and word and vocabulary completion. See " { $link "listener" } " for general information on the listener."
HELP: beep
{ $description "Plays the system beep sound." } ;
+HELP: system-alert
+{ $values { "caption" string } { "text" string } }
+{ $description "Displays an application-modal alert dialog box with the given caption and text." }
+{ $notes "Since the window raised by this word is modal, all processing in all Factor threads will halt until the dialog is dismissed. In an application that makes full use of the UI framework, it would be more appropriate to display a pane gadget in a Factor window. This word is meant primarily to be used to display errors in deployed applications with minimal dependencies on the UI library, such as games." } ;
+
HELP: topmost-window
{ $values { "world" world } }
{ $description "Returns the " { $link world } " representing the currently focused window." } ;
HOOK: beep ui-backend ( -- )
+HOOK: system-alert ui-backend ( caption text -- )
+
: parse-main-window-attributes ( class -- attributes )
"{" expect dup all-slots parse-tuple-literal-slots ;
+++ /dev/null
-unportable
{ path char[104] } ;
STRUCT: passwd
- { pw_name char* }
- { pw_passwd char* }
+ { pw_name c-string }
+ { pw_passwd c-string }
{ pw_uid uid_t }
{ pw_gid gid_t }
{ pw_change time_t }
- { pw_class char* }
- { pw_gecos char* }
- { pw_dir char* }
- { pw_shell char* }
+ { pw_class c-string }
+ { pw_gecos c-string }
+ { pw_dir c-string }
+ { pw_shell c-string }
{ pw_expire time_t }
{ pw_fields int } ;
{ socktype int }
{ protocol int }
{ addrlen socklen_t }
- { canonname char* }
+ { canonname c-string }
{ addr void* }
{ next addrinfo* } ;
+++ /dev/null
-unportable
{ socktype int }
{ protocol int }
{ addrlen socklen_t }
- { canonname char* }
+ { canonname c-string }
{ addr void* }
{ next addrinfo* } ;
CONSTANT: __DARWIN_MAXPATHLEN 1024
CONSTANT: __DARWIN_MAXNAMELEN 255
-CONSTANT: __DARWIN_MAXNAMELEN+1 255
+CONSTANT: __DARWIN_MAXNAMELEN+1 256
STRUCT: dirent
{ d_ino ino_t }
+++ /dev/null
-unportable
{ socktype int }
{ protocol int }
{ addrlen socklen_t }
- { canonname char* }
+ { canonname c-string }
{ addr void* }
{ next addrinfo* } ;
+++ /dev/null
-unportable
{ protocol int }
{ addrlen socklen_t }
{ addr void* }
- { canonname char* }
+ { canonname c-string }
{ next addrinfo* } ;
STRUCT: dirent
+++ /dev/null
-unportable
+++ /dev/null
-unportable
LIBRARY: libc
-FUNCTION: char* strerror ( int errno ) ;
+FUNCTION: c-string strerror ( int errno ) ;
STRUCT: group
- { gr_name char* }
- { gr_passwd char* }
+ { gr_name c-string }
+ { gr_passwd c-string }
{ gr_gid int }
- { gr_mem char** } ;
+ { gr_mem c-string* } ;
FUNCTION: int accept ( int s, void* sockaddr, socklen_t* socklen ) ;
FUNCTION: int bind ( int s, void* name, socklen_t namelen ) ;
-FUNCTION: int chdir ( char* path ) ;
-FUNCTION: int chmod ( char* path, mode_t mode ) ;
+FUNCTION: int chdir ( c-string path ) ;
+FUNCTION: int chmod ( c-string path, mode_t mode ) ;
FUNCTION: int fchmod ( int fd, mode_t mode ) ;
-FUNCTION: int chown ( char* path, uid_t owner, gid_t group ) ;
-FUNCTION: int chroot ( char* path ) ;
+FUNCTION: int chown ( c-string path, uid_t owner, gid_t group ) ;
+FUNCTION: int chroot ( c-string path ) ;
FUNCTION: int close ( int fd ) ;
FUNCTION: int closedir ( DIR* dirp ) ;
FUNCTION: int connect ( int s, void* name, socklen_t namelen ) ;
FUNCTION: int flock ( int fd, int operation ) ;
FUNCTION: void freeaddrinfo ( addrinfo* ai ) ;
FUNCTION: int futimes ( int id, timeval[2] times ) ;
-FUNCTION: char* gai_strerror ( int ecode ) ;
-FUNCTION: int getaddrinfo ( char* hostname, char* servname, addrinfo* hints, addrinfo** res ) ;
-FUNCTION: char* getcwd ( char* buf, size_t size ) ;
+FUNCTION: c-string gai_strerror ( int ecode ) ;
+FUNCTION: int getaddrinfo ( c-string hostname, c-string servname, addrinfo* hints, addrinfo** res ) ;
+FUNCTION: c-string getcwd ( c-string buf, size_t size ) ;
FUNCTION: pid_t getpid ;
FUNCTION: int getdtablesize ;
FUNCTION: gid_t getegid ;
FUNCTION: uid_t geteuid ;
FUNCTION: gid_t getgid ;
-FUNCTION: char* getenv ( char* name ) ;
+FUNCTION: c-string getenv ( c-string name ) ;
-FUNCTION: int getgrgid_r ( gid_t gid, group* grp, char* buffer, size_t bufsize, group** result ) ;
-FUNCTION: int getgrnam_r ( char* name, group* grp, char* buffer, size_t bufsize, group** result ) ;
+FUNCTION: int getgrgid_r ( gid_t gid, group* grp, c-string buffer, size_t bufsize, group** result ) ;
+FUNCTION: int getgrnam_r ( c-string name, group* grp, c-string buffer, size_t bufsize, group** result ) ;
FUNCTION: passwd* getpwent ( ) ;
FUNCTION: passwd* getpwuid ( uid_t uid ) ;
-FUNCTION: passwd* getpwnam ( char* login ) ;
-FUNCTION: int getpwnam_r ( char* login, passwd* pwd, char* buffer, size_t bufsize, passwd** result ) ;
+FUNCTION: passwd* getpwnam ( c-string login ) ;
+FUNCTION: int getpwnam_r ( c-string login, passwd* pwd, c-string buffer, size_t bufsize, passwd** result ) ;
FUNCTION: int getgroups ( int gidsetlen, gid_t* gidset ) ;
-FUNCTION: int getgrouplist ( char* name, int basegid, int* groups, int* ngroups ) ;
+FUNCTION: int getgrouplist ( c-string name, int basegid, int* groups, int* ngroups ) ;
FUNCTION: int getrlimit ( int resource, rlimit* rlp ) ;
FUNCTION: int setrlimit ( int resource, rlimit* rlp ) ;
FUNCTION: int getpriority ( int which, id_t who ) ;
FUNCTION: int setpriority ( int which, id_t who, int prio ) ;
FUNCTION: int getrusage ( int who, rusage* r_usage ) ;
FUNCTION: group* getgrent ;
-FUNCTION: int gethostname ( char* name, int len ) ;
+FUNCTION: int gethostname ( c-string name, int len ) ;
FUNCTION: int getsockname ( int socket, sockaddr* address, socklen_t* address_len ) ;
FUNCTION: int getpeername ( int socket, sockaddr* address, socklen_t* address_len ) ;
FUNCTION: uid_t getuid ;
FUNCTION: uint htonl ( uint n ) ;
FUNCTION: ushort htons ( ushort n ) ;
! FUNCTION: int issetugid ;
-FUNCTION: int ioctl ( int fd, ulong request, char* argp ) ;
-FUNCTION: int lchown ( char* path, uid_t owner, gid_t group ) ;
+FUNCTION: int isatty ( int fildes ) ;
+FUNCTION: int ioctl ( int fd, ulong request, c-string argp ) ;
+FUNCTION: int lchown ( c-string path, uid_t owner, gid_t group ) ;
FUNCTION: int listen ( int s, int backlog ) ;
FUNCTION: off_t lseek ( int fildes, off_t offset, int whence ) ;
-FUNCTION: int mkdir ( char* path, mode_t mode ) ;
+FUNCTION: int mkdir ( c-string path, mode_t mode ) ;
FUNCTION: void* mmap ( void* addr, size_t len, int prot, int flags, int fd, off_t offset ) ;
FUNCTION: int munmap ( void* addr, size_t len ) ;
FUNCTION: uint ntohl ( uint n ) ;
FUNCTION: ushort ntohs ( ushort n ) ;
FUNCTION: int shutdown ( int fd, int how ) ;
-FUNCTION: int open ( char* path, int flags, int prot ) ;
-FUNCTION: DIR* opendir ( char* path ) ;
+FUNCTION: int open ( c-string path, int flags, int prot ) ;
+FUNCTION: DIR* opendir ( c-string path ) ;
STRUCT: utimbuf
{ actime time_t }
{ modtime time_t } ;
-FUNCTION: int utime ( char* path, utimbuf* buf ) ;
+FUNCTION: int utime ( c-string path, utimbuf* buf ) ;
FUNCTION: int pclose ( void* file ) ;
FUNCTION: int pipe ( int* filedes ) ;
-FUNCTION: void* popen ( char* command, char* type ) ;
+FUNCTION: void* popen ( c-string command, c-string type ) ;
FUNCTION: ssize_t read ( int fd, void* buf, size_t nbytes ) ;
FUNCTION: dirent* readdir ( DIR* dirp ) ;
FUNCTION: int readdir_r ( void* dirp, dirent* entry, dirent** result ) ;
-FUNCTION: ssize_t readlink ( char* path, char* buf, size_t bufsize ) ;
+FUNCTION: ssize_t readlink ( c-string path, c-string buf, size_t bufsize ) ;
CONSTANT: PATH_MAX 1024
FUNCTION: ssize_t recv ( int s, void* buf, size_t nbytes, int flags ) ;
FUNCTION: ssize_t recvfrom ( int s, void* buf, size_t nbytes, int flags, sockaddr-in* from, socklen_t* fromlen ) ;
-FUNCTION: int rename ( char* from, char* to ) ;
-FUNCTION: int rmdir ( char* path ) ;
+FUNCTION: int rename ( c-string from, c-string to ) ;
+FUNCTION: int rmdir ( c-string path ) ;
FUNCTION: int select ( int nfds, void* readfds, void* writefds, void* exceptfds, timeval* timeout ) ;
FUNCTION: ssize_t sendto ( int s, void* buf, size_t len, int flags, sockaddr-in* to, socklen_t tolen ) ;
-FUNCTION: int setenv ( char* name, char* value, int overwrite ) ;
-FUNCTION: int unsetenv ( char* name ) ;
+FUNCTION: int setenv ( c-string name, c-string value, int overwrite ) ;
+FUNCTION: int unsetenv ( c-string name ) ;
FUNCTION: int setegid ( gid_t egid ) ;
FUNCTION: int seteuid ( uid_t euid ) ;
FUNCTION: int setgid ( gid_t gid ) ;
FUNCTION: int setsockopt ( int s, int level, int optname, void* optval, socklen_t optlen ) ;
FUNCTION: int setuid ( uid_t uid ) ;
FUNCTION: int socket ( int domain, int type, int protocol ) ;
-FUNCTION: int symlink ( char* path1, char* path2 ) ;
-FUNCTION: int link ( char* path1, char* path2 ) ;
-FUNCTION: int system ( char* command ) ;
-FUNCTION: int unlink ( char* path ) ;
-FUNCTION: int utimes ( char* path, timeval[2] times ) ;
+FUNCTION: int symlink ( c-string path1, c-string path2 ) ;
+FUNCTION: int link ( c-string path1, c-string path2 ) ;
+FUNCTION: int system ( c-string command ) ;
+FUNCTION: int unlink ( c-string path ) ;
+FUNCTION: int utimes ( c-string path, timeval[2] times ) ;
FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ;
"librt" "librt.so" "cdecl" add-library
{ protocol int }
{ addrlen socklen_t }
{ addr void* }
- { canonname char* }
+ { canonname c-string }
{ next addrinfo* } ;
STRUCT: sockaddr-in
CONSTANT: SEEK_END 2
STRUCT: passwd
- { pw_name char* }
- { pw_passwd char* }
+ { pw_name c-string }
+ { pw_passwd c-string }
{ pw_uid uid_t }
{ pw_gid gid_t }
- { pw_gecos char* }
- { pw_dir char* }
- { pw_shell char* } ;
+ { pw_gecos c-string }
+ { pw_dir c-string }
+ { pw_shell c-string } ;
! dirent64
STRUCT: dirent
{ d_type uchar }
{ d_name char[256] } ;
-FUNCTION: int open64 ( char* path, int flags, int prot ) ;
+FUNCTION: int open64 ( c-string path, int flags, int prot ) ;
FUNCTION: dirent* readdir64 ( DIR* dirp ) ;
FUNCTION: int readdir64_r ( void* dirp, dirent* entry, dirent** result ) ;
+++ /dev/null
-unportable
! int _ai_pad;
! #endif
{ addrlen int }
- { canonname char* }
+ { canonname c-string }
{ addr void* }
{ next void* } ;
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
user-name (user-groups) ;
: all-groups ( -- seq )
- [ unix.ffi:getgrent dup ] [ \ unix.ffi:group memory>struct group-struct>group ] produce nip ;
+ [ unix.ffi:getgrent dup ] [ group-struct>group ] produce nip ;
: <group-cache> ( -- assoc )
all-groups [ [ id>> ] keep ] H{ } map>assoc ;
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
} flags ; foldable\r
\r
FUNCTION: int inotify_init ( ) ;\r
-FUNCTION: int inotify_add_watch ( int fd, char* name, uint mask ) ;\r
+FUNCTION: int inotify_add_watch ( int fd, c-string name, uint mask ) ;\r
FUNCTION: int inotify_rm_watch ( int fd, uint wd ) ;\r
+++ /dev/null
-unportable
+++ /dev/null
-unportable
: fork-process ( -- pid ) [ fork ] unix-system-call ;
-FUNCTION: int execv ( char* path, char** argv ) ;
-FUNCTION: int execvp ( char* path, char** argv ) ;
-FUNCTION: int execve ( char* path, char** argv, char** envp ) ;
+FUNCTION: int execv ( c-string path, c-string* argv ) ;
+FUNCTION: int execvp ( c-string path, c-string* argv ) ;
+FUNCTION: int execve ( c-string path, c-string* argv, c-string* envp ) ;
: exec ( pathname argv -- int )
[ utf8 malloc-string ] [ utf8 strings>alien ] bi* execv ;
+++ /dev/null
-unportable
{ st_birthtimespec timespec }
{ pad0 __int32_t[2] } ;
-FUNCTION: int stat ( char* pathname, stat* buf ) ;
-FUNCTION: int lstat ( char* pathname, stat* buf ) ;
+FUNCTION: int stat ( c-string pathname, stat* buf ) ;
+FUNCTION: int lstat ( c-string pathname, stat* buf ) ;
+++ /dev/null
-unportable
{ st_ctimespec timespec }
{ st_ino ulonglong } ;
-FUNCTION: int __xstat64 ( int ver, char* pathname, stat* buf ) ;
-FUNCTION: int __lxstat64 ( int ver, char* pathname, stat* buf ) ;
+FUNCTION: int __xstat64 ( int ver, c-string pathname, stat* buf ) ;
+FUNCTION: int __lxstat64 ( int ver, c-string pathname, stat* buf ) ;
: stat ( pathname buf -- int ) [ 1 ] 2dip __xstat64 ;
: lstat ( pathname buf -- int ) [ 1 ] 2dip __lxstat64 ;
{ st_ctimespec timespec }
{ __unused0 long[3] } ;
-FUNCTION: int __xstat64 ( int ver, char* pathname, stat* buf ) ;
-FUNCTION: int __lxstat64 ( int ver, char* pathname, stat* buf ) ;
+FUNCTION: int __xstat64 ( int ver, c-string pathname, stat* buf ) ;
+FUNCTION: int __lxstat64 ( int ver, c-string pathname, stat* buf ) ;
: stat ( pathname buf -- int ) [ 1 ] 2dip __xstat64 ;
: lstat ( pathname buf -- int ) [ 1 ] 2dip __lxstat64 ;
+++ /dev/null
-unportable
{ st_qspare0 __int64_t }
{ st_qspare1 __int64_t } ;
-FUNCTION: int stat64 ( char* pathname, stat* buf ) ;
-FUNCTION: int lstat64 ( char* pathname, stat* buf ) ;
+FUNCTION: int stat64 ( c-string pathname, stat* buf ) ;
+FUNCTION: int lstat64 ( c-string pathname, stat* buf ) ;
: stat ( path buf -- n ) stat64 ;
: lstat ( path buf -- n ) lstat64 ;
+++ /dev/null
-unportable
{ st_gen uint32_t }
{ st_qspare uint32_t[2] } ;
-FUNCTION: int __stat30 ( char* pathname, stat* buf ) ;
-FUNCTION: int __lstat30 ( char* pathname, stat* buf ) ;
+FUNCTION: int __stat30 ( c-string pathname, stat* buf ) ;
+FUNCTION: int __lstat30 ( c-string pathname, stat* buf ) ;
: stat ( pathname buf -- n ) __stat30 ;
: lstat ( pathname buf -- n ) __lstat30 ;
{ st_spare0 uint32_t }
{ st_birthtimespec timespec } ;
-FUNCTION: int __stat13 ( char* pathname, stat* buf ) ;
-FUNCTION: int __lstat13 ( char* pathname, stat* buf ) ;
+FUNCTION: int __stat13 ( c-string pathname, stat* buf ) ;
+FUNCTION: int __lstat13 ( c-string pathname, stat* buf ) ;
: stat ( pathname buf -- n ) __stat13 ;
: lstat ( pathname buf -- n ) __lstat13 ;
+++ /dev/null
-unportable
{ st_birthtimespec timespec }
{ st_qspare int64_t[2] } ;
-FUNCTION: int stat ( char* pathname, stat* buf ) ;
-FUNCTION: int lstat ( char* pathname, stat* buf ) ;
+FUNCTION: int stat ( c-string pathname, stat* buf ) ;
+FUNCTION: int lstat ( c-string pathname, stat* buf ) ;
+++ /dev/null
-unportable
+++ /dev/null
-unportable
{ f_mntfromname { char MNAMELEN } }
{ f_mntonname { char MNAMELEN } } ;
-FUNCTION: int statfs ( char* path, statfs* buf ) ;
+FUNCTION: int statfs ( c-string path, statfs* buf ) ;
+++ /dev/null
-unportable
{ f_frsize __SWORD_TYPE }
{ f_spare __SWORD_TYPE[5] } ;
-FUNCTION: int statfs64 ( char* path, statfs64* buf ) ;
+FUNCTION: int statfs64 ( c-string path, statfs64* buf ) ;
+++ /dev/null
-unportable
{ f_mntfromname { char MAXPATHLEN } }
{ f_reserved uint32_t[8] } ;
-FUNCTION: int statfs64 ( char* path, statfs64* buf ) ;
+FUNCTION: int statfs64 ( c-string path, statfs64* buf ) ;
FUNCTION: int getmntinfo64 ( statfs64** mntbufp, int flags ) ;
+++ /dev/null
-unportable
{ f_mntfromname { char MNAMELEN } }
{ mount_info char[160] } ;
-FUNCTION: int statfs ( char* path, statfs* buf ) ;
+FUNCTION: int statfs ( c-string path, statfs* buf ) ;
+++ /dev/null
-unportable
CONSTANT: ST_RDONLY HEX: 1 ! Read-only file system
CONSTANT: ST_NOSUID HEX: 2 ! Does not honor setuid/setgid
-FUNCTION: int statvfs ( char* path, statvfs* buf ) ;
+FUNCTION: int statvfs ( c-string path, statvfs* buf ) ;
+++ /dev/null
-unportable
{ f_namemax ulong }
{ __f_spare int[6] } ;
-FUNCTION: int statvfs64 ( char* path, statvfs64* buf ) ;
+FUNCTION: int statvfs64 ( c-string path, statvfs64* buf ) ;
CONSTANT: ST_RDONLY 1 ! Mount read-only.
CONSTANT: ST_NOSUID 2 ! Ignore suid and sgid bits.
+++ /dev/null
-unportable
CONSTANT: ST_RDONLY HEX: 1 ! Read-only file system
CONSTANT: ST_NOSUID HEX: 2 ! Does not honor setuid/setgid
-FUNCTION: int statvfs ( char* path, statvfs* buf ) ;
+FUNCTION: int statvfs ( c-string path, statvfs* buf ) ;
+++ /dev/null
-unportable
{ f_mntonname { char _VFS_MNAMELEN } }
{ f_mntfromname { char _VFS_MNAMELEN } } ;
-FUNCTION: int statvfs ( char* path, statvfs* buf ) ;
+FUNCTION: int statvfs ( c-string path, statvfs* buf ) ;
+++ /dev/null
-unportable
CONSTANT: ST_RDONLY 1
CONSTANT: ST_NOSUID 2
-FUNCTION: int statvfs ( char* path, statvfs* buf ) ;
+FUNCTION: int statvfs ( c-string path, statvfs* buf ) ;
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
{ yday int }
{ isdst int }
{ gmtoff long }
- { zone char* } ;
+ { zone c-string } ;
FUNCTION: time_t time ( time_t* t ) ;
FUNCTION: tm* localtime ( time_t* clock ) ;
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
: all-users ( -- seq )
[
- [ unix.ffi:getpwent dup ] [ unix.ffi:passwd memory>struct passwd>new-passwd ] produce nip
+ [ unix.ffi:getpwent dup ] [ passwd>new-passwd ] produce nip
] with-pwent ;
SYMBOL: user-cache
M: integer user-passwd ( id -- passwd/f )
user-cache get
- [ at ] [ unix.ffi:getpwuid [ unix.ffi:passwd memory>struct passwd>new-passwd ] [ f ] if* ] if* ;
+ [ at ] [ unix.ffi:getpwuid [ passwd>new-passwd ] [ f ] if* ] if* ;
M: string user-passwd ( string -- passwd/f )
- unix.ffi:getpwnam dup [ unix.ffi:passwd memory>struct passwd>new-passwd ] when ;
+ unix.ffi:getpwnam dup [ passwd>new-passwd ] when ;
: user-name ( id -- string )
dup user-passwd
+++ /dev/null
-unportable
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax unix.bsd.macosx ;
+USING: alien.syntax unix.ffi.bsd.macosx ;
IN: unix.utmpx.macosx
! empty
+++ /dev/null
-unportable
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax unix.utmpx unix.bsd.netbsd accessors
-unix.utmpx system kernel unix combinators ;
+USING: alien.syntax unix unix.utmpx unix.ffi.bsd.netbsd accessors
+system kernel combinators ;
IN: unix.utmpx.netbsd
-TUPLE: netbsd-utmpx-record < utmpx-record termination exit
-sockaddr ;
-
+TUPLE: netbsd-utmpx-record < utmpx-record
+termination exit sockaddr ;
+
M: netbsd new-utmpx-record ( -- utmpx-record )
- netbsd-utmpx-record new ;
-
+ netbsd-utmpx-record new ;
+
M: netbsd utmpx>utmpx-record ( utmpx -- record )
- [ new-utmpx-record ] keep
- {
- [
- utmpx-ut_exit
- [ exit_struct-e_termination >>termination ]
- [ exit_struct-e_exit >>exit ] bi
- ]
- [ utmpx-ut_ss >>sockaddr ]
- } cleave ;
+ [ new-utmpx-record ] dip
+ [
+ ut_exit>>
+ [ e_termination>> >>termination ]
+ [ e_exit>> >>exit ] bi
+ ]
+ [ ut_ss>> >>sockaddr ] bi ;
+++ /dev/null
-unportable
--- /dev/null
+macosx
+netbsd
+++ /dev/null
-unportable
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.data alien.syntax combinators
continuations io.encodings.string io.encodings.utf8 kernel
-sequences strings unix calendar system accessors unix.time
-calendar.unix vocabs.loader classes.struct ;
+sequences strings calendar system accessors unix unix.time
+unix.ffi calendar.unix vocabs.loader classes.struct ;
IN: unix.utmpx
CONSTANT: EMPTY 0
CONSTANT: SIGNATURE 10
CONSTANT: SHUTDOWN_TIME 11
+C-TYPE: utmpx
+
FUNCTION: void setutxent ( ) ;
FUNCTION: void endutxent ( ) ;
FUNCTION: utmpx* getutxent ( ) ;
utmpx-record new ;
M: unix utmpx>utmpx-record ( utmpx -- utmpx-record )
- [ new-utmpx-record ] dip \ utmpx memory>struct
+ [ new-utmpx-record ] dip
{
[ ut_user>> _UTX_USERSIZE memory>string >>user ]
[ ut_id>> _UTX_IDSIZE memory>string >>id ]
USING: help.markup help.syntax strings ;
IN: vocabs.files
+HELP: vocab-tests-file
+{ $values { "vocab" "a vocabulary specifier" } { "path" "pathname string to test file" } }
+{ $description "Outputs a pathname where the unit test file is located." } ;
+
+HELP: vocab-tests-dir
+{ $values { "vocab" "a vocabulary specifier" } { "paths" "a sequence of pathname strings" } }
+{ $description "Outputs a sequence of pathnames for the tests in the test directory." } ;
+
HELP: vocab-files
{ $values { "vocab" "a vocabulary specifier" } { "seq" "a sequence of pathname strings" } }
{ $description "Outputs a sequence of files comprising this vocabulary, or " { $link f } " if the vocabulary does not have a directory on disk." } ;
sequences vocabs.loader ;
IN: vocabs.files
-<PRIVATE
-
: vocab-tests-file ( vocab -- path )
dup "-tests.factor" vocab-dir+ vocab-append-path dup
[ dup exists? [ drop f ] unless ] [ drop f ] if ;
] [ drop f ] if
] [ drop f ] if ;
-PRIVATE>
-
: vocab-tests ( vocab -- tests )
[
[ vocab-tests-file [ , ] when* ]
[ vocab-source-path [ , ] when* ]
[ vocab-docs-path [ , ] when* ]
[ vocab-tests % ] tri
- ] { } make ;
\ No newline at end of file
+ ] { } make ;
-Slava Pestov
\ No newline at end of file
+Slava Pestov
+Joe Groff
\ No newline at end of file
IN: vocabs.metadata
ARTICLE: "vocabs.metadata" "Vocabulary metadata"
-"Vocabulary summaries:"
+"Vocabulary directories can contain text files with metadata:"
+{ $list
+ { { $snippet "authors.txt" } " - a series of lines, with one author name per line. These are listed under " { $link "vocab-authors" } "." }
+ { { $snippet "platforms.txt" } " - a series of lines, with one operating system name per line." }
+ { { $snippet "resources.txt" } " - a series of lines, with one file glob pattern per line. Files inside the vocabulary directory whose names match any of these glob patterns will be included with the compiled application as " { $link "deploy-resources" } "." }
+ { { $snippet "summary.txt" } " - a one-line description." }
+ { { $snippet "tags.txt" } " - a series of lines, with one tag per line. Tags help classify the vocabulary. Consult " { $link "vocab-tags" } " for a list of existing tags you can reuse." }
+}
+"Words for reading and writing " { $snippet "summary.txt" } ":"
{ $subsections
vocab-summary
set-vocab-summary
}
-"Vocabulary authors:"
+"Words for reading and writing " { $snippet "authors.txt" } ":"
{ $subsections
vocab-authors
set-vocab-authors
}
-"Vocabulary tags:"
+"Words for reading and writing " { $snippet "tags.txt" } ":"
{ $subsections
vocab-tags
set-vocab-tags
add-vocab-tags
}
+"Words for reading and writing " { $snippet "platforms.txt" } ":"
+{ $subsections
+ vocab-platforms
+ set-vocab-platforms
+}
+"Words for reading and writing " { $snippet "resources.txt" } ":"
+{ $subsections
+ vocab-resources
+ set-vocab-resources
+}
"Getting and setting arbitrary vocabulary metadata:"
{ $subsections
vocab-file-contents
{ $values { "tags" "a sequence of strings" } { "vocab" "a vocabulary specifier" } }
{ $description "Stores a list of short tags classifying the vocabulary to the " { $snippet "tags.txt" } " file in the vocabulary's directory." } ;
+HELP: vocab-platforms
+{ $values { "vocab" "a vocabulary specifier" } { "platforms" "a sequence of operating system symbols" } }
+{ $description "Outputs a list of operating systems supported by " { $snippet "vocab" } ", as specified by the " { $snippet "platforms.txt" } " file in the vocabulary's directory. Outputs an empty array if the file doesn't exist." }
+{ $notes "Operating system symbols are defined in the " { $vocab-link "system" } " vocabulary." } ;
+
+HELP: set-vocab-platforms
+{ $values { "platforms" "a sequence of operating system symbols" } { "vocab" "a vocabulary specifier" } }
+{ $description "Stores a list of operating systems supported by " { $snippet "vocab" } " to the " { $snippet "platforms.txt" } " file in the vocabulary's directory." }
+{ $notes "Operating system symbols are defined in the " { $vocab-link "system" } " vocabulary." } ;
+
+HELP: vocab-resources
+{ $values { "vocab" "a vocabulary specifier" } { "patterns" "a sequence of glob patterns" } }
+{ $description "Outputs a list of glob patterns matching files that will be deployed with an application that includes " { $snippet "vocab" } ", as specified by the " { $snippet "resources.txt" } " file in the vocabulary's directory. Outputs an empty array if the file doesn't exist." }
+{ $notes "The " { $vocab-link "vocabs.metadata.resources" } " vocabulary contains words that will expand the glob patterns and directory names in " { $snippet "patterns" } " and return all the matching files." } ;
+
+HELP: set-vocab-resources
+{ $values { "patterns" "a sequence of glob patterns" } { "vocab" "a vocabulary specifier" } }
+{ $description "Stores a list of glob patterns matching files that will be deployed with an application that includes " { $snippet "vocab" } " to the " { $snippet "resources.txt" } " file in the vocabulary's directory." } ;
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov, Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs io.encodings.utf8 io.files
-io.pathnames kernel make math.parser memoize sequences sets
-sorting summary vocabs vocabs.loader ;
+USING: accessors arrays assocs io.directories io.encodings.utf8
+io.files io.pathnames kernel make math.parser memoize sequences
+sets sorting summary vocabs vocabs.loader words system
+classes.algebra combinators.short-circuit fry continuations
+namespaces ;
IN: vocabs.metadata
+: check-vocab ( vocab -- vocab )
+ dup find-vocab-root [ no-vocab ] unless ;
+
MEMO: vocab-file-contents ( vocab name -- seq )
vocab-append-path dup
[ dup exists? [ utf8 file-lines ] [ drop f ] if ] when ;
+: ?delete-file ( pathname -- ) '[ _ delete-file ] ignore-errors ;
+
: set-vocab-file-contents ( seq vocab name -- )
dupd vocab-append-path [
- utf8 set-file-lines
+ swap [ ?delete-file ] [ swap utf8 set-file-lines ] if-empty
\ vocab-file-contents reset-memoized
- ] [
- "The " swap vocab-name
- " vocabulary was not loaded from the file system"
- 3append throw
- ] ?if ;
+ ] [ vocab-name no-vocab ] ?if ;
+
+: vocab-windows-icon-path ( vocab -- string )
+ vocab-dir "icon.ico" append-path ;
+
+: vocab-mac-icon-path ( vocab -- string )
+ vocab-dir "icon.icns" append-path ;
+
+: vocab-resources-path ( vocab -- string )
+ vocab-dir "resources.txt" append-path ;
+
+: vocab-resources ( vocab -- patterns )
+ dup vocab-resources-path vocab-file-contents harvest ;
+
+: set-vocab-resources ( patterns vocab -- )
+ dup vocab-resources-path set-vocab-file-contents ;
: vocab-summary-path ( vocab -- string )
vocab-dir "summary.txt" append-path ;
: add-vocab-tags ( tags vocab -- )
[ vocab-tags append prune ] keep set-vocab-tags ;
+: remove-vocab-tags ( tags vocab -- )
+ [ vocab-tags swap diff ] keep set-vocab-tags ;
+
: vocab-authors-path ( vocab -- string )
vocab-dir "authors.txt" append-path ;
: set-vocab-authors ( authors vocab -- )
dup vocab-authors-path set-vocab-file-contents ;
+: vocab-platforms-path ( vocab -- string )
+ vocab-dir "platforms.txt" append-path ;
+
+ERROR: bad-platform name ;
+
+: vocab-platforms ( vocab -- platforms )
+ dup vocab-platforms-path vocab-file-contents
+ [ dup "system" lookup [ ] [ bad-platform ] ?if ] map ;
+
+: set-vocab-platforms ( platforms vocab -- )
+ [ [ name>> ] map ] dip
+ dup vocab-platforms-path set-vocab-file-contents ;
+
+: supported-platform? ( platforms -- ? )
+ [ t ] [ [ os swap class<= ] any? ] if-empty ;
+
: unportable? ( vocab -- ? )
- vocab-tags "unportable" swap member? ;
\ No newline at end of file
+ {
+ [ vocab-tags "untested" swap member? ]
+ [ vocab-platforms supported-platform? not ]
+ } 1|| ;
+
+TUPLE: unsupported-platform vocab requires ;
+
+: unsupported-platform ( vocab requires -- )
+ \ unsupported-platform boa throw-continue ;
+
+M: unsupported-platform summary
+ drop "Current operating system not supported by this vocabulary" ;
+
+[
+ dup vocab-platforms dup supported-platform?
+ [ 2drop ] [ [ vocab-name ] dip unsupported-platform ] if
+] check-vocab-hook set-global
--- /dev/null
+! (c)2010 Joe Groff bsd license
+USING: help.markup help.syntax kernel ;
+IN: vocabs.metadata.resources
+
+HELP: expand-vocab-resource-files
+{ $values
+ { "vocab" "a vocabulary specifier" } { "resource-glob-strings" "a sequence of glob patterns" }
+ { "filenames" "a sequence of filenames" }
+}
+{ $description "Matches all the glob patterns in " { $snippet "resource-glob-strings" } " to the set of files inside " { $snippet "vocab" } "'s directory and outputs a sequence containing the individual files and directories that match. Any matching directories will also have their contents recursively included in the output. The paths in the output will be relative to " { $snippet "vocab" } "'s directory." } ;
+
+HELP: vocab-resource-files
+{ $values
+ { "vocab" "a vocabulary specifier" }
+ { "filenames" "a sequence of filenames" }
+}
+{ $description "Outputs a sequence containing the individual resource files and directories that match the patterns specified in " { $snippet "vocab" } "'s " { $snippet "resources.txt" } " file. Any matching directories will also have their contents recursively included in the output. The paths in the output will be relative to " { $snippet "vocab" } "'s directory." } ;
+
+ARTICLE: "vocabs.metadata.resources" "Vocabulary resource metadata"
+"The " { $vocab-link "vocabs.metadata.resources" } " vocabulary contains words to retrieve the full list of files that match the patterns specified in a vocabulary's " { $snippet "resources.txt" } " file."
+{ $subsections
+ vocab-resource-files
+ expand-vocab-resource-files
+} ;
+
+ABOUT: "vocabs.metadata.resources"
--- /dev/null
+! (c)2010 Joe Groff bsd license
+USING: sorting tools.test vocabs.metadata.resources ;
+IN: vocabs.metadata.resources.tests
+
+[ { "bar" "bas" "foo" } ]
+[ "vocabs.metadata.resources.test.1" vocab-resource-files natural-sort ] unit-test
+
+[ { "bar.wtf" "foo.wtf" } ]
+[ "vocabs.metadata.resources.test.2" vocab-resource-files natural-sort ] unit-test
+
+[ {
+ "resource-dir"
+ "resource-dir/bar"
+ "resource-dir/bas"
+ "resource-dir/bas/zang"
+ "resource-dir/bas/zim"
+ "resource-dir/foo"
+} ] [ "vocabs.metadata.resources.test.3" vocab-resource-files natural-sort ] unit-test
--- /dev/null
+! (c)2010 Joe Groff bsd license
+USING: arrays fry globs io.directories io.files.info
+io.pathnames kernel regexp sequences vocabs.loader
+vocabs.metadata ;
+IN: vocabs.metadata.resources
+
+<PRIVATE
+
+: (expand-vocab-resource) ( resource-path -- filenames )
+ dup file-info directory?
+ [ dup '[ _ directory-tree-files [ append-path ] with map ] [ prefix ] bi ]
+ [ 1array ] if ;
+
+: filter-resources ( vocab-files resource-globs -- resource-files )
+ '[ _ [ matches? ] with any? ] filter ;
+
+: copy-vocab-resource ( to from file -- )
+ [ append-path ] curry bi@
+ dup file-info directory?
+ [ drop make-directories ]
+ [ swap [ parent-directory make-directories ] [ copy-file ] bi ] if ;
+
+PRIVATE>
+
+: vocab-dir-in-root ( vocab -- dir )
+ [ find-vocab-root ] [ vocab-dir ] bi append-path ;
+
+: expand-vocab-resource-files ( vocab resource-glob-strings -- filenames )
+ [ vocab-dir-in-root ] dip [ <glob> ] map '[
+ _ filter-resources
+ [ (expand-vocab-resource) ] map concat
+ ] with-directory-tree-files ;
+
+: vocab-resource-files ( vocab -- filenames )
+ dup vocab-resources
+ [ drop f ] [ expand-vocab-resource-files ] if-empty ;
+
+: copy-vocab-resources ( dir vocab -- )
+ dup vocab-resource-files
+ [ 2drop ] [
+ [ [ vocab-dir append-path ] [ vocab-dir-in-root ] bi ] dip
+ [ 2drop make-directories ]
+ [ [ copy-vocab-resource ] with with each ] 3bi
+ ] if-empty ;
+
--- /dev/null
+USING: io kernel ;
+IN: vocabs.metadata.resources.test.1
+
+: main ( -- ) "Resources test 1" print ;
+
+MAIN: main
--- /dev/null
+foo
+bar
+bas
--- /dev/null
+USING: io kernel ;
+IN: vocabs.metadata.resources.test.2
+
+: main ( -- ) "Resources test 2" print ;
+
+MAIN: main
--- /dev/null
+USING: io kernel ;
+IN: vocabs.metadata.resources.test.3
+
+: main ( -- ) "Resources test 3" print ;
+
+MAIN: main
--- /dev/null
+resource-dir
CONSTANT: KEY_WOW64_32KEY HEX: 0200
CONSTANT: KEY_WOW64_64KEY HEX: 0100
CONSTANT: KEY_WRITE HEX: 20006
-CONSTANT: KEY_EXECUTE KEY_READ
+ALIAS: KEY_EXECUTE KEY_READ
CONSTANT: KEY_ALL_ACCESS HEX: F003F
CONSTANT: REG_NONE 0
CONSTANT: REG_QWORD 11
CONSTANT: REG_QWORD_LITTLE_ENDIAN 11
+CONSTANT: REG_CREATED_NEW_KEY 1
+CONSTANT: REG_OPENED_EXISTING_KEY 2
+
TYPEDEF: DWORD REGSAM
! : I_ScGetCurrentGroupStateW ;
! : RegCreateKeyA ;
! : RegCreateKeyExA ;
FUNCTION: LONG RegCreateKeyExW ( HKEY hKey, LPCTSTR lpSubKey, DWORD Reserved, LPTSTR lpClass, DWORD dwOptions, REGSAM samDesired, LPSECURITY_ATTRIBUTES lpSecurityAttributes, PHKEY phkResult, LPDWORD lpdwDisposition ) ;
+ALIAS: RegCreateKeyEx RegCreateKeyExW
! : RegCreateKeyW
! : RegDeleteKeyA ;
! : RegDeleteKeyW ;
! : RegDisablePredefinedCache ;
! : RegEnumKeyA ;
! : RegEnumKeyExA ;
+
FUNCTION: LONG RegEnumKeyExW (
HKEY hKey,
DWORD dwIndex,
LPDWORD lpcClass,
PFILETIME lpftLastWriteTime
) ;
+ALIAS: RegEnumKeyEx RegEnumKeyExW
+
! : RegEnumKeyW ;
! : RegEnumValueA ;
! : RegSetValueA ;
! : RegSetValueExA ;
! : RegSetValueExW ;
-! : RegSetValueW ;
+FUNCTION: LONG RegSetValueExW ( HKEY hKey, LPCTSTR lpValueName, DWORD Reserved, DWORD dwType, BYTE* lpData, DWORD cbData ) ;
+ALIAS: RegSetValueEx RegSetValueExW
! : RegUnLoadKeyA ;
! : RegUnLoadKeyW ;
! : RegisterEventSourceA ;
+++ /dev/null
-unportable
+++ /dev/null
-unportable
USING: kernel windows.com windows.com.syntax windows.ole32
-alien alien.syntax tools.test libc alien.c-types
+windows.types alien alien.syntax tools.test libc alien.c-types
namespaces arrays continuations accessors math windows.com.wrapper
windows.com.wrapper.private destructors effects compiler.units ;
IN: windows.com.tests
int xPlus ( int y )
int xMulAdd ( int mul, int add ) ;
+COM-INTERFACE: ISelfReferential IUnknown {d4f45bf8-f720-4701-a09d-e8e341981121}
+ ISelfReferential* selfReference ( ) ;
+
{ GUID: {216fb341-0eb2-44b1-8edb-60b76e353abc} } [ ISimple-iid ] unit-test
{ GUID: {9620ecec-8438-423b-bb14-86f835aa40dd} } [ IInherited-iid ] unit-test
{ GUID: {00000000-0000-0000-C000-000000000046} } [ IUnknown-iid ] unit-test
ULONG Release ( ) ;
C-TYPE: IAdviseSink
+C-TYPE: IEnumFORMATETC
+C-TYPE: IEnumSTATDATA
COM-INTERFACE: IDataObject IUnknown {0000010E-0000-0000-C000-000000000046}
HRESULT GetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium )
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: windows.com windows.kernel32 windows.ole32
-prettyprint.custom prettyprint.sections sequences ;
+USING: windows.kernel32 windows.ole32 prettyprint.custom
+prettyprint.sections sequences ;
IN: windows.com.prettyprint
M: GUID pprint* guid>string "GUID: " prepend text ;
+++ /dev/null
-unportable
sequences namespaces assocs quotations generalizations
accessors words macros alien.syntax fry arrays layouts math
classes.struct windows.kernel32 ;
+FROM: alien.parser.private => return-type-name ;
IN: windows.com.syntax
<PRIVATE
: (parse-com-function) ( tokens -- definition )
[ second ]
- [ first ]
+ [ first parse-c-type ]
[
3 tail [ CHAR: , swap remove ] map
2 group [ first2 normalize-c-arg 2array ] map
: (stack-effect-from-return-and-parameters) ( return parameters -- stack-effect )
swap
[ [ second ] map ]
- [ dup void? [ drop { } ] [ 1array ] if ] bi*
+ [ dup void? [ drop { } ] [ return-type-name 1array ] if ] bi*
<effect> ;
: (define-word-for-function) ( function interface n -- )
: define-words-for-com-interface ( definition -- )
[ [ (iid-word) ] [ iid>> 1quotation ] bi (( -- iid )) define-declared ]
- [ word>> void* swap typedef ]
[
dup family-tree-functions
[ (define-word-for-function) ] with each-index
- ]
- tri ;
+ ] bi ;
PRIVATE>
SYNTAX: COM-INTERFACE:
CREATE-C-TYPE
+ void* over typedef
scan-object find-com-interface-definition
scan string>guid
parse-com-functions
-unportable
bindings
+ffi
: (make-query-interface) ( interfaces -- quot )
(query-interface-cases)
'[
- swap GUID memory>struct
- _ case
+ swap _ case
[
void* heap-size * rot <displaced-alien> com-add-ref
swap 0 set-alien-cell S_OK
--- /dev/null
+Erik Charlebois
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types alien.libraries alien.syntax classes.struct
+kernel math windows.types windows.ole32 ;
+IN: windows.ddk.hid
+
+<< "hid" "hid.dll" "stdcall" add-library >>
+LIBRARY: hid
+
+TYPEDEF: LONG NTSTATUS
+TYPEDEF: USHORT USAGE
+TYPEDEF: USAGE* PUSAGE
+
+CONSTANT: HID_USAGE_PAGE_UNDEFINED HEX: 00
+CONSTANT: HID_USAGE_PAGE_GENERIC HEX: 01
+CONSTANT: HID_USAGE_PAGE_SIMULATION HEX: 02
+CONSTANT: HID_USAGE_PAGE_VR HEX: 03
+CONSTANT: HID_USAGE_PAGE_SPORT HEX: 04
+CONSTANT: HID_USAGE_PAGE_GAME HEX: 05
+CONSTANT: HID_USAGE_PAGE_KEYBOARD HEX: 07
+CONSTANT: HID_USAGE_PAGE_LED HEX: 08
+CONSTANT: HID_USAGE_PAGE_BUTTON HEX: 09
+CONSTANT: HID_USAGE_PAGE_ORDINAL HEX: 0A
+CONSTANT: HID_USAGE_PAGE_TELEPHONY HEX: 0B
+CONSTANT: HID_USAGE_PAGE_CONSUMER HEX: 0C
+CONSTANT: HID_USAGE_PAGE_DIGITIZER HEX: 0D
+CONSTANT: HID_USAGE_PAGE_UNICODE HEX: 10
+CONSTANT: HID_USAGE_PAGE_ALPHANUMERIC HEX: 14
+
+CONSTANT: HID_USAGE_PAGE_MICROSOFT_BLUETOOTH_HANDSFREE HEX: FFF3
+
+CONSTANT: HID_USAGE_GENERIC_POINTER HEX: 01
+CONSTANT: HID_USAGE_GENERIC_MOUSE HEX: 02
+CONSTANT: HID_USAGE_GENERIC_JOYSTICK HEX: 04
+CONSTANT: HID_USAGE_GENERIC_GAMEPAD HEX: 05
+CONSTANT: HID_USAGE_GENERIC_KEYBOARD HEX: 06
+CONSTANT: HID_USAGE_GENERIC_KEYPAD HEX: 07
+CONSTANT: HID_USAGE_GENERIC_SYSTEM_CTL HEX: 80
+
+CONSTANT: HID_USAGE_GENERIC_X HEX: 30
+CONSTANT: HID_USAGE_GENERIC_Y HEX: 31
+CONSTANT: HID_USAGE_GENERIC_Z HEX: 32
+CONSTANT: HID_USAGE_GENERIC_RX HEX: 33
+CONSTANT: HID_USAGE_GENERIC_RY HEX: 34
+CONSTANT: HID_USAGE_GENERIC_RZ HEX: 35
+CONSTANT: HID_USAGE_GENERIC_SLIDER HEX: 36
+CONSTANT: HID_USAGE_GENERIC_DIAL HEX: 37
+CONSTANT: HID_USAGE_GENERIC_WHEEL HEX: 38
+CONSTANT: HID_USAGE_GENERIC_HATSWITCH HEX: 39
+CONSTANT: HID_USAGE_GENERIC_COUNTED_BUFFER HEX: 3A
+CONSTANT: HID_USAGE_GENERIC_BYTE_COUNT HEX: 3B
+CONSTANT: HID_USAGE_GENERIC_MOTION_WAKEUP HEX: 3C
+CONSTANT: HID_USAGE_GENERIC_VX HEX: 40
+CONSTANT: HID_USAGE_GENERIC_VY HEX: 41
+CONSTANT: HID_USAGE_GENERIC_VZ HEX: 42
+CONSTANT: HID_USAGE_GENERIC_VBRX HEX: 43
+CONSTANT: HID_USAGE_GENERIC_VBRY HEX: 44
+CONSTANT: HID_USAGE_GENERIC_VBRZ HEX: 45
+CONSTANT: HID_USAGE_GENERIC_VNO HEX: 46
+CONSTANT: HID_USAGE_GENERIC_SYSCTL_POWER HEX: 81
+CONSTANT: HID_USAGE_GENERIC_SYSCTL_SLEEP HEX: 82
+CONSTANT: HID_USAGE_GENERIC_SYSCTL_WAKE HEX: 83
+CONSTANT: HID_USAGE_GENERIC_SYSCTL_CONTEXT_MENU HEX: 84
+CONSTANT: HID_USAGE_GENERIC_SYSCTL_MAIN_MENU HEX: 85
+CONSTANT: HID_USAGE_GENERIC_SYSCTL_APP_MENU HEX: 86
+CONSTANT: HID_USAGE_GENERIC_SYSCTL_HELP_MENU HEX: 87
+CONSTANT: HID_USAGE_GENERIC_SYSCTL_MENU_EXIT HEX: 88
+CONSTANT: HID_USAGE_GENERIC_SYSCTL_MENU_SELECT HEX: 89
+CONSTANT: HID_USAGE_GENERIC_SYSCTL_MENU_RIGHT HEX: 8A
+CONSTANT: HID_USAGE_GENERIC_SYSCTL_MENU_LEFT HEX: 8B
+CONSTANT: HID_USAGE_GENERIC_SYSCTL_MENU_UP HEX: 8C
+CONSTANT: HID_USAGE_GENERIC_SYSCTL_MENU_DOWN HEX: 8D
+
+CONSTANT: HID_USAGE_SIMULATION_RUDDER HEX: BA
+CONSTANT: HID_USAGE_SIMULATION_THROTTLE HEX: BB
+
+CONSTANT: HID_USAGE_KEYBOARD_NOEVENT HEX: 00
+CONSTANT: HID_USAGE_KEYBOARD_ROLLOVER HEX: 01
+CONSTANT: HID_USAGE_KEYBOARD_POSTFAIL HEX: 02
+CONSTANT: HID_USAGE_KEYBOARD_UNDEFINED HEX: 03
+
+CONSTANT: HID_USAGE_KEYBOARD_aA HEX: 04
+CONSTANT: HID_USAGE_KEYBOARD_zZ HEX: 1D
+CONSTANT: HID_USAGE_KEYBOARD_ONE HEX: 1E
+CONSTANT: HID_USAGE_KEYBOARD_ZERO HEX: 27
+CONSTANT: HID_USAGE_KEYBOARD_LCTRL HEX: E0
+CONSTANT: HID_USAGE_KEYBOARD_LSHFT HEX: E1
+CONSTANT: HID_USAGE_KEYBOARD_LALT HEX: E2
+CONSTANT: HID_USAGE_KEYBOARD_LGUI HEX: E3
+CONSTANT: HID_USAGE_KEYBOARD_RCTRL HEX: E4
+CONSTANT: HID_USAGE_KEYBOARD_RSHFT HEX: E5
+CONSTANT: HID_USAGE_KEYBOARD_RALT HEX: E6
+CONSTANT: HID_USAGE_KEYBOARD_RGUI HEX: E7
+CONSTANT: HID_USAGE_KEYBOARD_SCROLL_LOCK HEX: 47
+CONSTANT: HID_USAGE_KEYBOARD_NUM_LOCK HEX: 53
+CONSTANT: HID_USAGE_KEYBOARD_CAPS_LOCK HEX: 39
+CONSTANT: HID_USAGE_KEYBOARD_F1 HEX: 3A
+CONSTANT: HID_USAGE_KEYBOARD_F12 HEX: 45
+CONSTANT: HID_USAGE_KEYBOARD_RETURN HEX: 28
+CONSTANT: HID_USAGE_KEYBOARD_ESCAPE HEX: 29
+CONSTANT: HID_USAGE_KEYBOARD_DELETE HEX: 2A
+CONSTANT: HID_USAGE_KEYBOARD_PRINT_SCREEN HEX: 46
+
+CONSTANT: HID_USAGE_LED_NUM_LOCK HEX: 01
+CONSTANT: HID_USAGE_LED_CAPS_LOCK HEX: 02
+CONSTANT: HID_USAGE_LED_SCROLL_LOCK HEX: 03
+CONSTANT: HID_USAGE_LED_COMPOSE HEX: 04
+CONSTANT: HID_USAGE_LED_KANA HEX: 05
+CONSTANT: HID_USAGE_LED_POWER HEX: 06
+CONSTANT: HID_USAGE_LED_SHIFT HEX: 07
+CONSTANT: HID_USAGE_LED_DO_NOT_DISTURB HEX: 08
+CONSTANT: HID_USAGE_LED_MUTE HEX: 09
+CONSTANT: HID_USAGE_LED_TONE_ENABLE HEX: 0A
+CONSTANT: HID_USAGE_LED_HIGH_CUT_FILTER HEX: 0B
+CONSTANT: HID_USAGE_LED_LOW_CUT_FILTER HEX: 0C
+CONSTANT: HID_USAGE_LED_EQUALIZER_ENABLE HEX: 0D
+CONSTANT: HID_USAGE_LED_SOUND_FIELD_ON HEX: 0E
+CONSTANT: HID_USAGE_LED_SURROUND_FIELD_ON HEX: 0F
+CONSTANT: HID_USAGE_LED_REPEAT HEX: 10
+CONSTANT: HID_USAGE_LED_STEREO HEX: 11
+CONSTANT: HID_USAGE_LED_SAMPLING_RATE_DETECT HEX: 12
+CONSTANT: HID_USAGE_LED_SPINNING HEX: 13
+CONSTANT: HID_USAGE_LED_CAV HEX: 14
+CONSTANT: HID_USAGE_LED_CLV HEX: 15
+CONSTANT: HID_USAGE_LED_RECORDING_FORMAT_DET HEX: 16
+CONSTANT: HID_USAGE_LED_OFF_HOOK HEX: 17
+CONSTANT: HID_USAGE_LED_RING HEX: 18
+CONSTANT: HID_USAGE_LED_MESSAGE_WAITING HEX: 19
+CONSTANT: HID_USAGE_LED_DATA_MODE HEX: 1A
+CONSTANT: HID_USAGE_LED_BATTERY_OPERATION HEX: 1B
+CONSTANT: HID_USAGE_LED_BATTERY_OK HEX: 1C
+CONSTANT: HID_USAGE_LED_BATTERY_LOW HEX: 1D
+CONSTANT: HID_USAGE_LED_SPEAKER HEX: 1E
+CONSTANT: HID_USAGE_LED_HEAD_SET HEX: 1F
+CONSTANT: HID_USAGE_LED_HOLD HEX: 20
+CONSTANT: HID_USAGE_LED_MICROPHONE HEX: 21
+CONSTANT: HID_USAGE_LED_COVERAGE HEX: 22
+CONSTANT: HID_USAGE_LED_NIGHT_MODE HEX: 23
+CONSTANT: HID_USAGE_LED_SEND_CALLS HEX: 24
+CONSTANT: HID_USAGE_LED_CALL_PICKUP HEX: 25
+CONSTANT: HID_USAGE_LED_CONFERENCE HEX: 26
+CONSTANT: HID_USAGE_LED_STAND_BY HEX: 27
+CONSTANT: HID_USAGE_LED_CAMERA_ON HEX: 28
+CONSTANT: HID_USAGE_LED_CAMERA_OFF HEX: 29
+CONSTANT: HID_USAGE_LED_ON_LINE HEX: 2A
+CONSTANT: HID_USAGE_LED_OFF_LINE HEX: 2B
+CONSTANT: HID_USAGE_LED_BUSY HEX: 2C
+CONSTANT: HID_USAGE_LED_READY HEX: 2D
+CONSTANT: HID_USAGE_LED_PAPER_OUT HEX: 2E
+CONSTANT: HID_USAGE_LED_PAPER_JAM HEX: 2F
+CONSTANT: HID_USAGE_LED_REMOTE HEX: 30
+CONSTANT: HID_USAGE_LED_FORWARD HEX: 31
+CONSTANT: HID_USAGE_LED_REVERSE HEX: 32
+CONSTANT: HID_USAGE_LED_STOP HEX: 33
+CONSTANT: HID_USAGE_LED_REWIND HEX: 34
+CONSTANT: HID_USAGE_LED_FAST_FORWARD HEX: 35
+CONSTANT: HID_USAGE_LED_PLAY HEX: 36
+CONSTANT: HID_USAGE_LED_PAUSE HEX: 37
+CONSTANT: HID_USAGE_LED_RECORD HEX: 38
+CONSTANT: HID_USAGE_LED_ERROR HEX: 39
+CONSTANT: HID_USAGE_LED_SELECTED_INDICATOR HEX: 3A
+CONSTANT: HID_USAGE_LED_IN_USE_INDICATOR HEX: 3B
+CONSTANT: HID_USAGE_LED_MULTI_MODE_INDICATOR HEX: 3C
+CONSTANT: HID_USAGE_LED_INDICATOR_ON HEX: 3D
+CONSTANT: HID_USAGE_LED_INDICATOR_FLASH HEX: 3E
+CONSTANT: HID_USAGE_LED_INDICATOR_SLOW_BLINK HEX: 3F
+CONSTANT: HID_USAGE_LED_INDICATOR_FAST_BLINK HEX: 40
+CONSTANT: HID_USAGE_LED_INDICATOR_OFF HEX: 41
+CONSTANT: HID_USAGE_LED_FLASH_ON_TIME HEX: 42
+CONSTANT: HID_USAGE_LED_SLOW_BLINK_ON_TIME HEX: 43
+CONSTANT: HID_USAGE_LED_SLOW_BLINK_OFF_TIME HEX: 44
+CONSTANT: HID_USAGE_LED_FAST_BLINK_ON_TIME HEX: 45
+CONSTANT: HID_USAGE_LED_FAST_BLINK_OFF_TIME HEX: 46
+CONSTANT: HID_USAGE_LED_INDICATOR_COLOR HEX: 47
+CONSTANT: HID_USAGE_LED_RED HEX: 48
+CONSTANT: HID_USAGE_LED_GREEN HEX: 49
+CONSTANT: HID_USAGE_LED_AMBER HEX: 4A
+CONSTANT: HID_USAGE_LED_GENERIC_INDICATOR HEX: 4B
+
+CONSTANT: HID_USAGE_TELEPHONY_PHONE HEX: 01
+CONSTANT: HID_USAGE_TELEPHONY_ANSWERING_MACHINE HEX: 02
+CONSTANT: HID_USAGE_TELEPHONY_MESSAGE_CONTROLS HEX: 03
+CONSTANT: HID_USAGE_TELEPHONY_HANDSET HEX: 04
+CONSTANT: HID_USAGE_TELEPHONY_HEADSET HEX: 05
+CONSTANT: HID_USAGE_TELEPHONY_KEYPAD HEX: 06
+CONSTANT: HID_USAGE_TELEPHONY_PROGRAMMABLE_BUTTON HEX: 07
+CONSTANT: HID_USAGE_TELEPHONY_REDIAL HEX: 24
+CONSTANT: HID_USAGE_TELEPHONY_TRANSFER HEX: 25
+CONSTANT: HID_USAGE_TELEPHONY_DROP HEX: 26
+CONSTANT: HID_USAGE_TELEPHONY_LINE HEX: 2A
+CONSTANT: HID_USAGE_TELEPHONY_RING_ENABLE HEX: 2D
+CONSTANT: HID_USAGE_TELEPHONY_SEND HEX: 31
+CONSTANT: HID_USAGE_TELEPHONY_KEYPAD_0 HEX: B0
+CONSTANT: HID_USAGE_TELEPHONY_KEYPAD_D HEX: BF
+CONSTANT: HID_USAGE_TELEPHONY_HOST_AVAILABLE HEX: F1
+
+CONSTANT: HID_USAGE_MS_BTH_HF_DIALNUMBER HEX: 21
+CONSTANT: HID_USAGE_MS_BTH_HF_DIALMEMORY HEX: 22
+
+CONSTANT: HID_USAGE_CONSUMERCTRL HEX: 01
+CONSTANT: HID_USAGE_DIGITIZER_PEN HEX: 02
+CONSTANT: HID_USAGE_DIGITIZER_IN_RANGE HEX: 32
+CONSTANT: HID_USAGE_DIGITIZER_TIP_SWITCH HEX: 42
+CONSTANT: HID_USAGE_DIGITIZER_BARREL_SWITCH HEX: 44
+
+CONSTANT: HIDP_LINK_COLLECTION_ROOT -1
+CONSTANT: HIDP_LINK_COLLECTION_UNSPECIFIED 0
+
+C-ENUM:
+ HidP_Input
+ HidP_Output
+ HidP_Feature ;
+TYPEDEF: int HIDP_REPORT_TYPE
+
+STRUCT: USAGE_AND_PAGE
+ { Usage USAGE }
+ { UsagePage USAGE } ;
+TYPEDEF: USAGE_AND_PAGE* PUSAGE_AND_PAGE
+
+: HidP_IsSameUsageAndPage ( u1 u2 -- ? ) = ; inline
+
+STRUCT: HIDP_BUTTONS_CAPS_range
+ { UsageMin USAGE }
+ { UsageMax USAGE }
+ { StringMin USHORT }
+ { StringMax USHORT }
+ { DesignatorMin USHORT }
+ { DesignatorMax USHORT }
+ { DataIndexMin USHORT }
+ { DataIndexMax USHORT } ;
+
+STRUCT: HIDP_BUTTONS_CAPS_not_range
+ { Usage USAGE }
+ { Reserved1 USAGE }
+ { StringIndex USHORT }
+ { Reserved2 USHORT }
+ { DesignatorIndex USHORT }
+ { Reserved3 USHORT }
+ { DataIndex USHORT }
+ { Reserved4 USHORT } ;
+
+UNION-STRUCT: HIDP_BUTTONS_CAPS_union
+ { Range HIDP_BUTTONS_CAPS_range }
+ { NotRange HIDP_BUTTONS_CAPS_not_range } ;
+
+STRUCT: HIDP_BUTTON_CAPS
+ { UsagePage USAGE }
+ { ReportID UCHAR }
+ { IsAlias BOOLEAN }
+ { BitField USHORT }
+ { LinkCollection USHORT }
+ { LinkUsage USAGE }
+ { LinkUsagePage USAGE }
+ { IsRange BOOLEAN }
+ { IsStringRange BOOLEAN }
+ { IsDesignatorRange BOOLEAN }
+ { IsAbsolute BOOLEAN }
+ { Reserved ULONG[10] }
+ { Union HIDP_BUTTONS_CAPS_union } ;
+TYPEDEF: HIDP_BUTTON_CAPS* PHIDP_BUTTON_CAPS
+
+STRUCT: HIDP_VALUE_CAPS_range
+ { UsageMin USAGE }
+ { UsageMax USAGE }
+ { StringMin USHORT }
+ { StringMax USHORT }
+ { DesignatorMin USHORT }
+ { DesignatorMax USHORT }
+ { DataIndexMin USHORT }
+ { DataIndexMax USHORT } ;
+
+STRUCT: HIDP_VALUE_CAPS_not_range
+ { Usage USAGE }
+ { Reserved1 USAGE }
+ { StringIndex USHORT }
+ { Reserved2 USHORT }
+ { DesignatorIndex USHORT }
+ { Reserved3 USHORT }
+ { DataIndex USHORT }
+ { Reserved4 USHORT } ;
+
+UNION-STRUCT: HIDP_VALUE_CAPS_union
+ { Range HIDP_VALUE_CAPS_range }
+ { NotRange HIDP_VALUE_CAPS_not_range } ;
+
+STRUCT: HIDP_VALUE_CAPS
+ { UsagePage USAGE }
+ { ReportID UCHAR }
+ { IsAlias BOOLEAN }
+ { BitField USHORT }
+ { LinkCollection USHORT }
+ { LinkUsage USAGE }
+ { LinkUsagePage USAGE }
+ { IsRange BOOLEAN }
+ { IsStringRange BOOLEAN }
+ { IsDesignatorRange BOOLEAN }
+ { IsAbsolute BOOLEAN }
+ { HasNull BOOLEAN }
+ { Reserved UCHAR }
+ { BitSize USHORT }
+ { ReportCount USHORT }
+ { Reserved2 USHORT[5] }
+ { UnitsExp ULONG }
+ { Units ULONG }
+ { LogicalMin LONG }
+ { LogicalMax LONG }
+ { PhysicalMin LONG }
+ { PhysicalMax LONG }
+ { Union HIDP_VALUE_CAPS_union } ;
+TYPEDEF: HIDP_VALUE_CAPS* PHIDP_VALUE_CAPS
+
+STRUCT: HIDP_LINK_COLLECTION_NODE
+ { LinkUsage USAGE }
+ { LinkUsagePage USAGE }
+ { Parent USHORT }
+ { NumberOfChildren USHORT }
+ { NextSibling USHORT }
+ { FirstChild USHORT }
+ { CollectionTypeIsAliasBitfield ULONG }
+ { UserContext PVOID } ;
+TYPEDEF: HIDP_LINK_COLLECTION_NODE* PHIDP_LINK_COLLECTION_NODE
+
+TYPEDEF: PUCHAR PHIDP_REPORT_DESCRIPTOR
+C-TYPE: HIDP_PREPARSED_DATA
+TYPEDEF: HIDP_PREPARSED_DATA* PHIDP_PREPARSED_DATA
+
+STRUCT: HIDP_CAPS
+ { Usage USAGE }
+ { UsagePage USAGE }
+ { InputReportByteLength USHORT }
+ { OutputReportByteLength USHORT }
+ { FeatureReportByteLength USHORT }
+ { Reserved USHORT[17] }
+ { NumberLinkCollectionNodes USHORT }
+ { NumberInputButtonCaps USHORT }
+ { NumberInputValueCaps USHORT }
+ { NumberInputDataIndices USHORT }
+ { NumberOutputButtonCaps USHORT }
+ { NumberOutputValueCaps USHORT }
+ { NumberOutputDataIndices USHORT }
+ { NumberFeatureButtonCaps USHORT }
+ { NumberFeatureValueCaps USHORT }
+ { NumberFeatureDataIndices USHORT } ;
+TYPEDEF: HIDP_CAPS* PHIDP_CAPS
+
+STRUCT: HIDP_DATA
+ { DataIndex USHORT }
+ { Reserved USHORT }
+ { RawValue ULONG } ;
+TYPEDEF: HIDP_DATA* PHIDP_DATA
+
+STRUCT: HIDP_UNKNOWN_TOKEN
+ { Token UCHAR }
+ { Reserved UCHAR[3] }
+ { BitField ULONG } ;
+TYPEDEF: HIDP_UNKNOWN_TOKEN* PHIDP_UNKNOWN_TOKEN
+
+STRUCT: HIDP_EXTENDED_ATTRIBUTES
+ { NumGlobalUnknowns UCHAR }
+ { Reserved UCHAR[3] }
+ { GlobalUnknowns PHIDP_UNKNOWN_TOKEN }
+ { Data ULONG[1] } ;
+TYPEDEF: HIDP_EXTENDED_ATTRIBUTES* PHIDP_EXTENDED_ATTRIBUTES
+
+FUNCTION: NTSTATUS
+HidP_GetCaps (
+ PHIDP_PREPARSED_DATA PreparsedData,
+ PHIDP_CAPS Capabilities
+ ) ;
+
+FUNCTION: NTSTATUS
+HidP_GetLinkCollectionNodes (
+ PHIDP_LINK_COLLECTION_NODE LinkCollectionNodes,
+ PULONG LinkCollectionNodesLength,
+ PHIDP_PREPARSED_DATA PreparsedData
+ ) ;
+
+FUNCTION: NTSTATUS
+HidP_GetSpecificButtonCaps (
+ HIDP_REPORT_TYPE ReportType,
+ USAGE UsagePage,
+ USHORT LinkCollection,
+ USAGE Usage,
+ PHIDP_BUTTON_CAPS ButtonCaps,
+ PUSHORT ButtonCapsLength,
+ PHIDP_PREPARSED_DATA PreparsedData
+ ) ;
+
+FUNCTION: NTSTATUS
+HidP_GetButtonCaps (
+ HIDP_REPORT_TYPE ReportType,
+ PHIDP_BUTTON_CAPS ButtonCaps,
+ PUSHORT ButtonCapsLength,
+ PHIDP_PREPARSED_DATA PreparsedData
+) ;
+
+FUNCTION: NTSTATUS
+HidP_GetSpecificValueCaps (
+ HIDP_REPORT_TYPE ReportType,
+ USAGE UsagePage,
+ USHORT LinkCollection,
+ USAGE Usage,
+ PHIDP_VALUE_CAPS ValueCaps,
+ PUSHORT ValueCapsLength,
+ PHIDP_PREPARSED_DATA PreparsedData
+ ) ;
+
+FUNCTION: NTSTATUS
+HidP_GetValueCaps (
+ HIDP_REPORT_TYPE ReportType,
+ PHIDP_VALUE_CAPS ValueCaps,
+ PUSHORT ValueCapsLength,
+ PHIDP_PREPARSED_DATA PreparsedData
+) ;
+
+FUNCTION: NTSTATUS
+HidP_GetExtendedAttributes (
+ HIDP_REPORT_TYPE ReportType,
+ USHORT DataIndex,
+ PHIDP_PREPARSED_DATA PreparsedData,
+ PHIDP_EXTENDED_ATTRIBUTES Attributes,
+ PULONG LengthAttributes
+ ) ;
+
+FUNCTION: NTSTATUS
+HidP_InitializeReportForID (
+ HIDP_REPORT_TYPE ReportType,
+ UCHAR ReportID,
+ PHIDP_PREPARSED_DATA PreparsedData,
+ PCHAR Report,
+ ULONG ReportLength
+ ) ;
+
+FUNCTION: NTSTATUS
+HidP_SetData (
+ HIDP_REPORT_TYPE ReportType,
+ PHIDP_DATA DataList,
+ PULONG DataLength,
+ PHIDP_PREPARSED_DATA PreparsedData,
+ PCHAR Report,
+ ULONG ReportLength
+ ) ;
+
+FUNCTION: NTSTATUS
+HidP_GetData (
+ HIDP_REPORT_TYPE ReportType,
+ PHIDP_DATA DataList,
+ PULONG DataLength,
+ PHIDP_PREPARSED_DATA PreparsedData,
+ PCHAR Report,
+ ULONG ReportLength
+ ) ;
+
+FUNCTION: ULONG
+HidP_MaxDataListLength (
+ HIDP_REPORT_TYPE ReportType,
+ PHIDP_PREPARSED_DATA PreparsedData
+ ) ;
+
+FUNCTION: NTSTATUS
+HidP_SetUsages (
+ HIDP_REPORT_TYPE ReportType,
+ USAGE UsagePage,
+ USHORT LinkCollection,
+ PUSAGE UsageList,
+ PULONG UsageLength,
+ PHIDP_PREPARSED_DATA PreparsedData,
+ PCHAR Report,
+ ULONG ReportLength
+ ) ;
+ALIAS: HidP_SetButtons HidP_SetUsages
+
+FUNCTION: NTSTATUS
+HidP_UnsetUsages (
+ HIDP_REPORT_TYPE ReportType,
+ USAGE UsagePage,
+ USHORT LinkCollection,
+ PUSAGE UsageList,
+ PULONG UsageLength,
+ PHIDP_PREPARSED_DATA PreparsedData,
+ PCHAR Report,
+ ULONG ReportLength
+ ) ;
+ALIAS: HidP_UnsetButtons HidP_UnsetUsages
+
+FUNCTION: NTSTATUS
+HidP_GetUsages (
+ HIDP_REPORT_TYPE ReportType,
+ USAGE UsagePage,
+ USHORT LinkCollection,
+ PUSAGE UsageList,
+ PULONG UsageLength,
+ PHIDP_PREPARSED_DATA PreparsedData,
+ PCHAR Report,
+ ULONG ReportLength
+ ) ;
+ALIAS: HidP_GetButtons HidP_GetUsages
+
+FUNCTION: NTSTATUS
+HidP_GetUsagesEx (
+ HIDP_REPORT_TYPE ReportType,
+ USHORT LinkCollection,
+ PUSAGE_AND_PAGE ButtonList,
+ ULONG* UsageLength,
+ PHIDP_PREPARSED_DATA PreparsedData,
+ PCHAR Report,
+ ULONG ReportLength
+ ) ;
+ALIAS: HidP_GetButtonsEx HidP_GetUsagesEx
+
+FUNCTION: ULONG
+HidP_MaxUsageListLength (
+ HIDP_REPORT_TYPE ReportType,
+ USAGE UsagePage,
+ PHIDP_PREPARSED_DATA PreparsedData
+ ) ;
+
+FUNCTION: NTSTATUS
+HidP_SetUsageValue (
+ HIDP_REPORT_TYPE ReportType,
+ USAGE UsagePage,
+ USHORT LinkCollection,
+ USAGE Usage,
+ ULONG UsageValue,
+ PHIDP_PREPARSED_DATA PreparsedData,
+ PCHAR Report,
+ ULONG ReportLength
+ ) ;
+
+FUNCTION: NTSTATUS
+HidP_SetScaledUsageValue (
+ HIDP_REPORT_TYPE ReportType,
+ USAGE UsagePage,
+ USHORT LinkCollection,
+ USAGE Usage,
+ LONG UsageValue,
+ PHIDP_PREPARSED_DATA PreparsedData,
+ PCHAR Report,
+ ULONG ReportLength
+ ) ;
+
+FUNCTION: NTSTATUS
+HidP_SetUsageValueArray (
+ HIDP_REPORT_TYPE ReportType,
+ USAGE UsagePage,
+ USHORT LinkCollection,
+ USAGE Usage,
+ PCHAR UsageValue,
+ USHORT UsageValueByteLength,
+ PHIDP_PREPARSED_DATA PreparsedData,
+ PCHAR Report,
+ ULONG ReportLength
+ ) ;
+
+
+FUNCTION: NTSTATUS
+HidP_GetUsageValue (
+ HIDP_REPORT_TYPE ReportType,
+ USAGE UsagePage,
+ USHORT LinkCollection,
+ USAGE Usage,
+ PULONG UsageValue,
+ PHIDP_PREPARSED_DATA PreparsedData,
+ PCHAR Report,
+ ULONG ReportLength
+ ) ;
+
+FUNCTION: NTSTATUS
+HidP_GetScaledUsageValue (
+ HIDP_REPORT_TYPE ReportType,
+ USAGE UsagePage,
+ USHORT LinkCollection,
+ USAGE Usage,
+ PLONG UsageValue,
+ PHIDP_PREPARSED_DATA PreparsedData,
+ PCHAR Report,
+ ULONG ReportLength
+ ) ;
+
+FUNCTION: NTSTATUS
+HidP_GetUsageValueArray (
+ HIDP_REPORT_TYPE ReportType,
+ USAGE UsagePage,
+ USHORT LinkCollection,
+ USAGE Usage,
+ PCHAR UsageValue,
+ USHORT UsageValueByteLength,
+ PHIDP_PREPARSED_DATA PreparsedData,
+ PCHAR Report,
+ ULONG ReportLength
+ ) ;
+
+FUNCTION: NTSTATUS
+HidP_UsageListDifference (
+ PUSAGE PreviousUsageList,
+ PUSAGE CurrentUsageList,
+ PUSAGE BreakUsageList,
+ PUSAGE MakeUsageList,
+ ULONG UsageListLength
+ ) ;
+
+FUNCTION: NTSTATUS
+HidP_UsageAndPageListDifference (
+ PUSAGE_AND_PAGE PreviousUsageList,
+ PUSAGE_AND_PAGE CurrentUsageList,
+ PUSAGE_AND_PAGE BreakUsageList,
+ PUSAGE_AND_PAGE MakeUsageList,
+ ULONG UsageListLength
+ ) ;
+
+C-ENUM:
+ HidP_Keyboard_Break
+ HidP_Keyboard_Make ;
+TYPEDEF: int HIDP_KEYBOARD_DIRECTION
+
+STRUCT: HIDP_KEYBOARD_MODIFIER_STATE
+ { ul ULONG } ;
+TYPEDEF: HIDP_KEYBOARD_MODIFIER_STATE* PHIDP_KEYBOARD_MODIFIER_STATE
+
+CALLBACK: BOOLEAN PHIDP_INSERT_SCANCODES (
+ PVOID Context,
+ PCHAR NewScanCodes,
+ ULONG Length ) ;
+
+FUNCTION: NTSTATUS
+HidP_TranslateUsageAndPagesToI8042ScanCodes (
+ PUSAGE_AND_PAGE ChangedUsageList,
+ ULONG UsageListLength,
+ HIDP_KEYBOARD_DIRECTION KeyAction,
+ PHIDP_KEYBOARD_MODIFIER_STATE ModifierState,
+ PHIDP_INSERT_SCANCODES InsertCodesProcedure,
+ PVOID InsertCodesContext
+ ) ;
+
+
+FUNCTION: NTSTATUS
+HidP_TranslateUsagesToI8042ScanCodes (
+ PUSAGE ChangedUsageList,
+ ULONG UsageListLength,
+ HIDP_KEYBOARD_DIRECTION KeyAction,
+ PHIDP_KEYBOARD_MODIFIER_STATE ModifierState,
+ PHIDP_INSERT_SCANCODES InsertCodesProcedure,
+ PVOID InsertCodesContext
+ ) ;
+
+CONSTANT: FACILITY_HID_ERROR_CODE HEX: 11
+: HIDP_ERROR_CODES ( SEV CODE -- HRESULT )
+ [ 28 shift ] dip bitor FACILITY_HID_ERROR_CODE 16 shift bitor ; inline
+: HIDP_STATUS_SUCCESS ( -- HRESULT ) HEX: 0 HEX: 0 HIDP_ERROR_CODES ; inline
+: HIDP_STATUS_NULL ( -- HRESULT ) HEX: 8 HEX: 1 HIDP_ERROR_CODES ; inline
+: HIDP_STATUS_INVALID_PREPARSED_DATA ( -- HRESULT ) HEX: C HEX: 1 HIDP_ERROR_CODES ; inline
+: HIDP_STATUS_INVALID_REPORT_TYPE ( -- HRESULT ) HEX: C HEX: 2 HIDP_ERROR_CODES ; inline
+: HIDP_STATUS_INVALID_REPORT_LENGTH ( -- HRESULT ) HEX: C HEX: 3 HIDP_ERROR_CODES ; inline
+: HIDP_STATUS_USAGE_NOT_FOUND ( -- HRESULT ) HEX: C HEX: 4 HIDP_ERROR_CODES ; inline
+: HIDP_STATUS_VALUE_OUT_OF_RANGE ( -- HRESULT ) HEX: C HEX: 5 HIDP_ERROR_CODES ; inline
+: HIDP_STATUS_BAD_LOG_PHY_VALUES ( -- HRESULT ) HEX: C HEX: 6 HIDP_ERROR_CODES ; inline
+: HIDP_STATUS_BUFFER_TOO_SMALL ( -- HRESULT ) HEX: C HEX: 7 HIDP_ERROR_CODES ; inline
+: HIDP_STATUS_INTERNAL_ERROR ( -- HRESULT ) HEX: C HEX: 8 HIDP_ERROR_CODES ; inline
+: HIDP_STATUS_I8042_TRANS_UNKNOWN ( -- HRESULT ) HEX: C HEX: 9 HIDP_ERROR_CODES ; inline
+: HIDP_STATUS_INCOMPATIBLE_REPORT_ID ( -- HRESULT ) HEX: C HEX: A HIDP_ERROR_CODES ; inline
+: HIDP_STATUS_NOT_VALUE_ARRAY ( -- HRESULT ) HEX: C HEX: B HIDP_ERROR_CODES ; inline
+: HIDP_STATUS_IS_VALUE_ARRAY ( -- HRESULT ) HEX: C HEX: C HIDP_ERROR_CODES ; inline
+: HIDP_STATUS_DATA_INDEX_NOT_FOUND ( -- HRESULT ) HEX: C HEX: D HIDP_ERROR_CODES ; inline
+: HIDP_STATUS_DATA_INDEX_OUT_OF_RANGE ( -- HRESULT ) HEX: C HEX: E HIDP_ERROR_CODES ; inline
+: HIDP_STATUS_BUTTON_NOT_PRESSED ( -- HRESULT ) HEX: C HEX: F HIDP_ERROR_CODES ; inline
+: HIDP_STATUS_REPORT_DOES_NOT_EXIST ( -- HRESULT ) HEX: C HEX: 10 HIDP_ERROR_CODES ; inline
+: HIDP_STATUS_NOT_IMPLEMENTED ( -- HRESULT ) HEX: C HEX: 20 HIDP_ERROR_CODES ; inline
+: HIDP_STATUS_I8242_TRANS_UNKNOWN ( -- HRESULT ) HIDP_STATUS_I8042_TRANS_UNKNOWN ; inline
+
+STRUCT: HIDD_CONFIGURATION
+ { cookie PVOID }
+ { size ULONG }
+ { RingBufferSize ULONG } ;
+TYPEDEF: HIDD_CONFIGURATION* PHIDD_CONFIGURATION
+
+STRUCT: HIDD_ATTRIBUTES
+ { Size ULONG }
+ { VendorID USHORT }
+ { ProductID USHORT }
+ { VersionNumber USHORT } ;
+TYPEDEF: HIDD_ATTRIBUTES* PHIDD_ATTRIBUTES
+
+FUNCTION: BOOLEAN
+HidD_GetAttributes (
+ HANDLE HidDeviceObject,
+ PHIDD_ATTRIBUTES Attributes
+ ) ;
+
+FUNCTION: void
+HidD_GetHidGuid (
+ LPGUID HidGuid
+ ) ;
+
+FUNCTION: BOOLEAN
+HidD_GetPreparsedData (
+ HANDLE HidDeviceObject,
+ PHIDP_PREPARSED_DATA* PreparsedData
+ ) ;
+
+FUNCTION: BOOLEAN
+HidD_FreePreparsedData (
+ PHIDP_PREPARSED_DATA PreparsedData
+ ) ;
+
+FUNCTION: BOOLEAN
+HidD_FlushQueue (
+ HANDLE HidDeviceObject
+ ) ;
+
+FUNCTION: BOOLEAN
+HidD_GetConfiguration (
+ HANDLE HidDeviceObject,
+ PHIDD_CONFIGURATION Configuration,
+ ULONG ConfigurationLength
+ ) ;
+
+FUNCTION: BOOLEAN
+HidD_SetConfiguration (
+ HANDLE HidDeviceObject,
+ PHIDD_CONFIGURATION Configuration,
+ ULONG ConfigurationLength
+ ) ;
+
+FUNCTION: BOOLEAN
+HidD_GetFeature (
+ HANDLE HidDeviceObject,
+ PVOID ReportBuffer,
+ ULONG ReportBufferLength
+ ) ;
+
+FUNCTION: BOOLEAN
+HidD_SetFeature (
+ HANDLE HidDeviceObject,
+ PVOID ReportBuffer,
+ ULONG ReportBufferLength
+ ) ;
+
+FUNCTION: BOOLEAN
+HidD_GetInputReport (
+ HANDLE HidDeviceObject,
+ PVOID ReportBuffer,
+ ULONG ReportBufferLength
+ ) ;
+
+FUNCTION: BOOLEAN
+HidD_SetOutputReport (
+ HANDLE HidDeviceObject,
+ PVOID ReportBuffer,
+ ULONG ReportBufferLength
+ ) ;
+
+FUNCTION: BOOLEAN
+HidD_GetNumInputBuffers (
+ HANDLE HidDeviceObject,
+ PULONG NumberBuffers
+ ) ;
+
+FUNCTION: BOOLEAN
+HidD_SetNumInputBuffers (
+ HANDLE HidDeviceObject,
+ ULONG NumberBuffers
+ ) ;
+
+FUNCTION: BOOLEAN
+HidD_GetPhysicalDescriptor (
+ HANDLE HidDeviceObject,
+ PVOID Buffer,
+ ULONG BufferLength
+ ) ;
+
+FUNCTION: BOOLEAN
+HidD_GetManufacturerString (
+ HANDLE HidDeviceObject,
+ PVOID Buffer,
+ ULONG BufferLength
+ ) ;
+
+FUNCTION: BOOLEAN
+HidD_GetProductString (
+ HANDLE HidDeviceObject,
+ PVOID Buffer,
+ ULONG BufferLength
+ ) ;
+
+FUNCTION: BOOLEAN
+HidD_GetIndexedString (
+ HANDLE HidDeviceObject,
+ ULONG StringIndex,
+ PVOID Buffer,
+ ULONG BufferLength
+ ) ;
+
+FUNCTION: BOOLEAN
+HidD_GetSerialNumberString (
+ HANDLE HidDeviceObject,
+ PVOID Buffer,
+ ULONG BufferLength
+ ) ;
+
+FUNCTION: BOOLEAN
+HidD_GetMsGenreDescriptor (
+ HANDLE HidDeviceObject,
+ PVOID Buffer,
+ ULONG BufferLength
+ ) ;
--- /dev/null
+Bindings to the HID section of the Windows DDK
\ No newline at end of file
--- /dev/null
+unportable bindings
\ No newline at end of file
--- /dev/null
+Erik Charlebois\r
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: literals windows.kernel32 math alien.syntax windows.types classes.struct
+alien.c-types windows.errors windows.ole32 windows.advapi32 alien.libraries ;
+IN: windows.ddk.setupapi
+
+<< "setupapi" "setupapi.dll" "stdcall" add-library >>
+LIBRARY: setupapi
+
+TYPEDEF: DWORDLONG SP_LOG_TOKEN
+TYPEDEF: DWORDLONG* PSP_LOG_TOKEN
+
+CONSTANT: LOGTOKEN_TYPE_MASK 3
+CONSTANT: LOGTOKEN_UNSPECIFIED 0
+CONSTANT: LOGTOKEN_NO_LOG 1
+CONSTANT: LOGTOKEN_SETUPAPI_APPLOG 2
+CONSTANT: LOGTOKEN_SETUPAPI_DEVLOG 3
+
+CONSTANT: TXTLOG_SETUPAPI_DEVLOG HEX: 00000001
+CONSTANT: TXTLOG_SETUPAPI_CMDLINE HEX: 00000002
+CONSTANT: TXTLOG_SETUPAPI_BITS HEX: 00000003
+
+CONSTANT: TXTLOG_ERROR HEX: 1
+CONSTANT: TXTLOG_WARNING HEX: 2
+CONSTANT: TXTLOG_SYSTEM_STATE_CHANGE HEX: 3
+CONSTANT: TXTLOG_SUMMARY HEX: 4
+CONSTANT: TXTLOG_DETAILS HEX: 5
+CONSTANT: TXTLOG_VERBOSE HEX: 6
+CONSTANT: TXTLOG_VERY_VERBOSE HEX: 7
+
+CONSTANT: TXTLOG_RESERVED_FLAGS HEX: 0000FFF0
+
+CONSTANT: TXTLOG_TIMESTAMP HEX: 00010000
+CONSTANT: TXTLOG_DEPTH_INCR HEX: 00020000
+CONSTANT: TXTLOG_DEPTH_DECR HEX: 00040000
+CONSTANT: TXTLOG_TAB_1 HEX: 00080000
+CONSTANT: TXTLOG_FLUSH_FILE HEX: 00100000
+
+: TXTLOG_LEVEL ( flags -- n ) HEX: f bitand ; inline
+
+CONSTANT: TXTLOG_DEVINST HEX: 00000001
+CONSTANT: TXTLOG_INF HEX: 00000002
+CONSTANT: TXTLOG_FILEQ HEX: 00000004
+CONSTANT: TXTLOG_COPYFILES HEX: 00000008
+CONSTANT: TXTLOG_SIGVERIF HEX: 00000020
+CONSTANT: TXTLOG_BACKUP HEX: 00000080
+CONSTANT: TXTLOG_UI HEX: 00000100
+CONSTANT: TXTLOG_UTIL HEX: 00000200
+CONSTANT: TXTLOG_INFDB HEX: 00000400
+CONSTANT: TXTLOG_POLICY HEX: 00800000
+CONSTANT: TXTLOG_NEWDEV HEX: 01000000
+CONSTANT: TXTLOG_UMPNPMGR HEX: 02000000
+CONSTANT: TXTLOG_DRIVER_STORE HEX: 04000000
+CONSTANT: TXTLOG_SETUP HEX: 08000000
+CONSTANT: TXTLOG_CMI HEX: 10000000
+CONSTANT: TXTLOG_DEVMGR HEX: 20000000
+CONSTANT: TXTLOG_INSTALLER HEX: 40000000
+CONSTANT: TXTLOG_VENDOR HEX: 80000000
+
+TYPEDEF: void* HPROPSHEETPAGE
+TYPEDEF: void* HIMAGELIST
+C-TYPE: DEVPROPKEY
+TYPEDEF: ULONG DEVPROPTYPE
+TYPEDEF: DEVPROPTYPE* PDEVPROPTYPE
+TYPEDEF: void* LPPROPSHEETHEADERA
+TYPEDEF: void* LPPROPSHEETHEADERW
+
+CONSTANT: LINE_LEN 256
+CONSTANT: LINE_LEN*2 512
+CONSTANT: MAX_INF_STRING_LENGTH 4096
+CONSTANT: MAX_INF_SECTION_NAME_LENGTH 255
+CONSTANT: MAX_TITLE_LEN 60
+CONSTANT: MAX_INSTRUCTION_LEN 256
+CONSTANT: MAX_LABEL_LEN 30
+CONSTANT: MAX_SERVICE_NAME_LEN 256
+CONSTANT: MAX_SUBTITLE_LEN 256
+CONSTANT: SP_MAX_MACHINENAME_LENGTH $[ MAX_PATH 3 + ]
+
+TYPEDEF: PVOID HINF
+
+STRUCT: INFCONTEXT
+ { Inf PVOID }
+ { CurrentInf PVOID }
+ { Section UINT }
+ { Line UINT } ;
+TYPEDEF: INFCONTEXT* PINFCONTEXT
+
+STRUCT: SP_INF_INFORMATION
+ { InfStyle DWORD }
+ { InfCount DWORD }
+ { VersionDat BYTE[ANYSIZE_ARRAY] } ;
+TYPEDEF: SP_INF_INFORMATION* PSP_INF_INFORMATION
+
+STRUCT: SP_ALTPLATFORM_INFO_V2
+ { cbSize DWORD }
+ { Platform DWORD }
+ { MajorVersion DWORD }
+ { MinorVersion DWORD }
+ { ProcessorArchitecture WORD }
+ { Flags WORD }
+ { FirstValidatedMajorVersion DWORD }
+ { FirstValidatedMinorVersion DWORD } ;
+TYPEDEF: SP_ALTPLATFORM_INFO_V2* PSP_ALTPLATFORM_INFO_V2
+
+STRUCT: SP_ALTPLATFORM_INFO_V1
+ { cbSize DWORD }
+ { Platform DWORD }
+ { MajorVersion DWORD }
+ { MinorVersion DWORD }
+ { ProcessorArchitecture WORD }
+ { Reserved WORD } ;
+TYPEDEF: SP_ALTPLATFORM_INFO_V1* PSP_ALTPLATFORM_INFO_V1
+TYPEDEF: SP_ALTPLATFORM_INFO_V2 SP_ALTPLATFORM_INFO
+TYPEDEF: PSP_ALTPLATFORM_INFO_V2 PSP_ALTPLATFORM_INFO
+
+CONSTANT: SP_ALTPLATFORM_FLAGS_VERSION_RANGE 1
+
+STRUCT: SP_ORIGINAL_FILE_INFO_A
+ { cbSize DWORD }
+ { OriginalInfName CHAR[MAX_PATH] }
+ { OriginalCatalogName CHAR[MAX_PATH] } ;
+TYPEDEF: SP_ORIGINAL_FILE_INFO_A* PSP_ORIGINAL_FILE_INFO_A
+STRUCT: SP_ORIGINAL_FILE_INFO_W
+ { cbSize DWORD }
+ { OriginalInfName WCHAR[MAX_PATH] }
+ { OriginalCatalogName WCHAR[MAX_PATH] } ;
+TYPEDEF: SP_ORIGINAL_FILE_INFO_W* PSP_ORIGINAL_FILE_INFO_W
+TYPEDEF: SP_ORIGINAL_FILE_INFO_W SP_ORIGINAL_FILE_INFO
+TYPEDEF: PSP_ORIGINAL_FILE_INFO_W PSP_ORIGINAL_FILE_INFO
+
+CONSTANT: INF_STYLE_NONE HEX: 00000000
+CONSTANT: INF_STYLE_OLDNT HEX: 00000001
+CONSTANT: INF_STYLE_WIN4 HEX: 00000002
+CONSTANT: INF_STYLE_CACHE_ENABLE HEX: 00000010
+CONSTANT: INF_STYLE_CACHE_DISABLE HEX: 00000020
+CONSTANT: INF_STYLE_CACHE_IGNORE HEX: 00000040
+CONSTANT: DIRID_ABSOLUTE -1
+CONSTANT: DIRID_ABSOLUTE_16BIT HEX: ffff
+CONSTANT: DIRID_NULL 0
+CONSTANT: DIRID_SRCPATH 1
+CONSTANT: DIRID_WINDOWS 10
+CONSTANT: DIRID_SYSTEM 11
+CONSTANT: DIRID_DRIVERS 12
+CONSTANT: DIRID_IOSUBSYS $ DIRID_DRIVERS
+CONSTANT: DIRID_INF 17
+CONSTANT: DIRID_HELP 18
+CONSTANT: DIRID_FONTS 20
+CONSTANT: DIRID_VIEWERS 21
+CONSTANT: DIRID_COLOR 23
+CONSTANT: DIRID_APPS 24
+CONSTANT: DIRID_SHARED 25
+CONSTANT: DIRID_BOOT 30
+CONSTANT: DIRID_SYSTEM16 50
+CONSTANT: DIRID_SPOOL 51
+CONSTANT: DIRID_SPOOLDRIVERS 52
+CONSTANT: DIRID_USERPROFILE 53
+CONSTANT: DIRID_LOADER 54
+CONSTANT: DIRID_PRINTPROCESSOR 55
+CONSTANT: DIRID_DEFAULT $ DIRID_SYSTEM
+CONSTANT: DIRID_COMMON_STARTMENU 16406
+CONSTANT: DIRID_COMMON_PROGRAMS 16407
+CONSTANT: DIRID_COMMON_STARTUP 16408
+CONSTANT: DIRID_COMMON_DESKTOPDIRECTORY 16409
+CONSTANT: DIRID_COMMON_FAVORITES 16415
+CONSTANT: DIRID_COMMON_APPDATA 16419
+CONSTANT: DIRID_PROGRAM_FILES 16422
+CONSTANT: DIRID_SYSTEM_X86 16425
+CONSTANT: DIRID_PROGRAM_FILES_X86 16426
+CONSTANT: DIRID_PROGRAM_FILES_COMMON 16427
+CONSTANT: DIRID_PROGRAM_FILES_COMMONX86 16428
+CONSTANT: DIRID_COMMON_TEMPLATES 16429
+CONSTANT: DIRID_COMMON_DOCUMENTS 16430
+CONSTANT: DIRID_USER HEX: 8000
+CALLBACK: UINT PSP_FILE_CALLBACK_A ( PVOID Context, UINT Notification, UINT_PTR Param1, UINT_PTR Param2 ) ;
+CALLBACK: UINT PSP_FILE_CALLBACK_W ( PVOID Context, UINT Notification, UINT_PTR Param1, UINT_PTR Param2 ) ;
+TYPEDEF: PSP_FILE_CALLBACK_W PSP_FILE_CALLBACK
+CONSTANT: SPFILENOTIFY_STARTQUEUE HEX: 00000001
+CONSTANT: SPFILENOTIFY_ENDQUEUE HEX: 00000002
+CONSTANT: SPFILENOTIFY_STARTSUBQUEUE HEX: 00000003
+CONSTANT: SPFILENOTIFY_ENDSUBQUEUE HEX: 00000004
+CONSTANT: SPFILENOTIFY_STARTDELETE HEX: 00000005
+CONSTANT: SPFILENOTIFY_ENDDELETE HEX: 00000006
+CONSTANT: SPFILENOTIFY_DELETEERROR HEX: 00000007
+CONSTANT: SPFILENOTIFY_STARTRENAME HEX: 00000008
+CONSTANT: SPFILENOTIFY_ENDRENAME HEX: 00000009
+CONSTANT: SPFILENOTIFY_RENAMEERROR HEX: 0000000a
+CONSTANT: SPFILENOTIFY_STARTCOPY HEX: 0000000b
+CONSTANT: SPFILENOTIFY_ENDCOPY HEX: 0000000c
+CONSTANT: SPFILENOTIFY_COPYERROR HEX: 0000000d
+CONSTANT: SPFILENOTIFY_NEEDMEDIA HEX: 0000000e
+CONSTANT: SPFILENOTIFY_QUEUESCAN HEX: 0000000f
+CONSTANT: SPFILENOTIFY_CABINETINFO HEX: 00000010
+CONSTANT: SPFILENOTIFY_FILEINCABINET HEX: 00000011
+CONSTANT: SPFILENOTIFY_NEEDNEWCABINET HEX: 00000012
+CONSTANT: SPFILENOTIFY_FILEEXTRACTED HEX: 00000013
+CONSTANT: SPFILENOTIFY_FILEOPDELAYED HEX: 00000014
+CONSTANT: SPFILENOTIFY_STARTBACKUP HEX: 00000015
+CONSTANT: SPFILENOTIFY_BACKUPERROR HEX: 00000016
+CONSTANT: SPFILENOTIFY_ENDBACKUP HEX: 00000017
+CONSTANT: SPFILENOTIFY_QUEUESCAN_EX HEX: 00000018
+CONSTANT: SPFILENOTIFY_STARTREGISTRATION HEX: 00000019
+CONSTANT: SPFILENOTIFY_ENDREGISTRATION HEX: 00000020
+CONSTANT: SPFILENOTIFY_QUEUESCAN_SIGNERINFO HEX: 00000040
+CONSTANT: SPFILENOTIFY_LANGMISMATCH HEX: 00010000
+CONSTANT: SPFILENOTIFY_TARGETEXISTS HEX: 00020000
+CONSTANT: SPFILENOTIFY_TARGETNEWER HEX: 00040000
+CONSTANT: FILEOP_COPY 0
+CONSTANT: FILEOP_RENAME 1
+CONSTANT: FILEOP_DELETE 2
+CONSTANT: FILEOP_BACKUP 3
+CONSTANT: FILEOP_ABORT 0
+CONSTANT: FILEOP_DOIT 1
+CONSTANT: FILEOP_SKIP 2
+CONSTANT: FILEOP_RETRY $ FILEOP_DOIT
+CONSTANT: FILEOP_NEWPATH 4
+CONSTANT: COPYFLG_WARN_IF_SKIP HEX: 00000001
+CONSTANT: COPYFLG_NOSKIP HEX: 00000002
+CONSTANT: COPYFLG_NOVERSIONCHECK HEX: 00000004
+CONSTANT: COPYFLG_FORCE_FILE_IN_USE HEX: 00000008
+CONSTANT: COPYFLG_NO_OVERWRITE HEX: 00000010
+CONSTANT: COPYFLG_NO_VERSION_DIALOG HEX: 00000020
+CONSTANT: COPYFLG_OVERWRITE_OLDER_ONLY HEX: 00000040
+CONSTANT: COPYFLG_PROTECTED_WINDOWS_DRIVER_FILE HEX: 00000100
+CONSTANT: COPYFLG_REPLACEONLY HEX: 00000400
+CONSTANT: COPYFLG_NODECOMP HEX: 00000800
+CONSTANT: COPYFLG_REPLACE_BOOT_FILE HEX: 00001000
+CONSTANT: COPYFLG_NOPRUNE HEX: 00002000
+CONSTANT: COPYFLG_IN_USE_TRY_RENAME HEX: 00004000
+CONSTANT: DELFLG_IN_USE HEX: 00000001
+CONSTANT: DELFLG_IN_USE1 HEX: 00010000
+STRUCT: FILEPATHS_A
+ { Target PCSTR }
+ { Source PCSTR }
+ { Win32Error UINT }
+ { Flags DWORD } ;
+TYPEDEF: FILEPATHS_A* PFILEPATHS_A
+STRUCT: FILEPATHS_W
+ { Target PCWSTR }
+ { Source PCWSTR }
+ { Win32Error UINT }
+ { Flags DWORD } ;
+TYPEDEF: FILEPATHS_W* PFILEPATHS_W
+TYPEDEF: FILEPATHS_W FILEPATHS
+TYPEDEF: PFILEPATHS_W PFILEPATHS
+STRUCT: FILEPATHS_SIGNERINFO_A
+ { Target PCSTR }
+ { Source PCSTR }
+ { Win32Error UINT }
+ { Flags DWORD }
+ { DigitalSigner PCSTR }
+ { Version PCSTR }
+ { CatalogFile PCSTR } ;
+TYPEDEF: FILEPATHS_SIGNERINFO_A* PFILEPATHS_SIGNERINFO_A
+STRUCT: FILEPATHS_SIGNERINFO_W
+ { Target PCWSTR }
+ { Source PCWSTR }
+ { Win32Error UINT }
+ { Flags DWORD }
+ { DigitalSigner PCWSTR }
+ { Version PCWSTR }
+ { CatalogFile PCWSTR } ;
+TYPEDEF: FILEPATHS_SIGNERINFO_W* PFILEPATHS_SIGNERINFO_W
+TYPEDEF: FILEPATHS_SIGNERINFO_W FILEPATHS_SIGNERINFO
+TYPEDEF: PFILEPATHS_SIGNERINFO_W PFILEPATHS_SIGNERINFO
+
+STRUCT: SOURCE_MEDIA_A
+ { Reserved PCSTR }
+ { Tagfile PCSTR }
+ { Description PCSTR }
+ { SourcePath PCSTR }
+ { SourceFile PCSTR }
+ { Flags DWORD } ;
+TYPEDEF: SOURCE_MEDIA_A* PSOURCE_MEDIA_A
+STRUCT: SOURCE_MEDIA_W
+ { Reserved PCWSTR }
+ { Tagfile PCWSTR }
+ { Description PCWSTR }
+ { SourcePath PCWSTR }
+ { SourceFile PCWSTR }
+ { Flags DWORD } ;
+TYPEDEF: SOURCE_MEDIA_W* PSOURCE_MEDIA_W
+TYPEDEF: SOURCE_MEDIA_W SOURCE_MEDIA
+TYPEDEF: PSOURCE_MEDIA_W PSOURCE_MEDIA
+
+STRUCT: CABINET_INFO_A
+ { CabinetPath PCSTR }
+ { CabinetFile PCSTR }
+ { DiskName PCSTR }
+ { SetId USHORT }
+ { CabinetNumber USHORT } ;
+TYPEDEF: CABINET_INFO_A* PCABINET_INFO_A
+STRUCT: CABINET_INFO_W
+ { CabinetPath PCWSTR }
+ { CabinetFile PCWSTR }
+ { DiskName PCWSTR }
+ { SetId USHORT }
+ { CabinetNumber USHORT } ;
+TYPEDEF: CABINET_INFO_W* PCABINET_INFO_W
+TYPEDEF: CABINET_INFO_W CABINET_INFO
+TYPEDEF: PCABINET_INFO_W PCABINET_INFO
+
+STRUCT: FILE_IN_CABINET_INFO_A
+ { NameInCabinet PCSTR }
+ { FileSize DWORD }
+ { Win32Error DWORD }
+ { DosDate WORD }
+ { DosTime WORD }
+ { DosAttribs WORD }
+ { FullTargetName CHAR[MAX_PATH] } ;
+TYPEDEF: FILE_IN_CABINET_INFO_A* PFILE_IN_CABINET_INFO_A
+STRUCT: FILE_IN_CABINET_INFO_W
+ { NameInCabinet PCWSTR }
+ { FileSize DWORD }
+ { Win32Error DWORD }
+ { DosDate WORD }
+ { DosTime WORD }
+ { DosAttribs WORD }
+ { FullTargetName WCHAR[MAX_PATH] } ;
+TYPEDEF: FILE_IN_CABINET_INFO_W* PFILE_IN_CABINET_INFO_W
+TYPEDEF: FILE_IN_CABINET_INFO_W FILE_IN_CABINET_INFO
+TYPEDEF: PFILE_IN_CABINET_INFO_W PFILE_IN_CABINET_INFO
+
+STRUCT: SP_REGISTER_CONTROL_STATUSA
+ { cbSize DWORD }
+ { FileName PCSTR }
+ { Win32Error DWORD }
+ { FailureCode DWORD } ;
+TYPEDEF: SP_REGISTER_CONTROL_STATUSA* PSP_REGISTER_CONTROL_STATUSA
+STRUCT: SP_REGISTER_CONTROL_STATUSW
+ { cbSize DWORD }
+ { FileName PCWSTR }
+ { Win32Error DWORD }
+ { FailureCode DWORD } ;
+TYPEDEF: SP_REGISTER_CONTROL_STATUSW* PSP_REGISTER_CONTROL_STATUSW
+
+TYPEDEF: SP_REGISTER_CONTROL_STATUSW SP_REGISTER_CONTROL_STATUS
+TYPEDEF: PSP_REGISTER_CONTROL_STATUSW PSP_REGISTER_CONTROL_STATUS
+
+CONSTANT: SPREG_SUCCESS HEX: 00000000
+CONSTANT: SPREG_LOADLIBRARY HEX: 00000001
+CONSTANT: SPREG_GETPROCADDR HEX: 00000002
+CONSTANT: SPREG_REGSVR HEX: 00000003
+CONSTANT: SPREG_DLLINSTALL HEX: 00000004
+CONSTANT: SPREG_TIMEOUT HEX: 00000005
+CONSTANT: SPREG_UNKNOWN HEX: FFFFFFFF
+
+TYPEDEF: PVOID HSPFILEQ
+
+STRUCT: SP_FILE_COPY_PARAMS_A
+ { cbSize DWORD }
+ { QueueHandle HSPFILEQ }
+ { SourceRootPath PCSTR }
+ { SourcePath PCSTR }
+ { SourceFilename PCSTR }
+ { SourceDescription PCSTR }
+ { SourceTagfile PCSTR }
+ { TargetDirectory PCSTR }
+ { TargetFilename PCSTR }
+ { CopyStyle DWORD }
+ { LayoutInf HINF }
+ { SecurityDescriptor PCSTR } ;
+TYPEDEF: SP_FILE_COPY_PARAMS_A* PSP_FILE_COPY_PARAMS_A
+STRUCT: SP_FILE_COPY_PARAMS_W
+ { cbSize DWORD }
+ { QueueHandle HSPFILEQ }
+ { SourceRootPath PCWSTR }
+ { SourcePath PCWSTR }
+ { SourceFilename PCWSTR }
+ { SourceDescription PCWSTR }
+ { SourceTagfile PCWSTR }
+ { TargetDirectory PCWSTR }
+ { TargetFilename PCWSTR }
+ { CopyStyle DWORD }
+ { LayoutInf HINF }
+ { SecurityDescriptor PCWSTR } ;
+TYPEDEF: SP_FILE_COPY_PARAMS_W* PSP_FILE_COPY_PARAMS_W
+
+TYPEDEF: SP_FILE_COPY_PARAMS_W SP_FILE_COPY_PARAMS
+TYPEDEF: PSP_FILE_COPY_PARAMS_W PSP_FILE_COPY_PARAMS
+
+TYPEDEF: PVOID HDSKSPC
+TYPEDEF: PVOID HDEVINFO
+
+STRUCT: SP_DEVINFO_DATA
+ { cbSize DWORD }
+ { ClassGuid GUID }
+ { DevInst DWORD }
+ { Reserved ULONG_PTR } ;
+TYPEDEF: SP_DEVINFO_DATA* PSP_DEVINFO_DATA
+STRUCT: SP_DEVICE_INTERFACE_DATA
+ { cbSize DWORD }
+ { InterfaceClassGuid GUID }
+ { Flags DWORD }
+ { Reserved ULONG_PTR } ;
+TYPEDEF: SP_DEVICE_INTERFACE_DATA* PSP_DEVICE_INTERFACE_DATA
+
+CONSTANT: SPINT_ACTIVE HEX: 00000001
+CONSTANT: SPINT_DEFAULT HEX: 00000002
+CONSTANT: SPINT_REMOVED HEX: 00000004
+TYPEDEF: SP_DEVICE_INTERFACE_DATA SP_INTERFACE_DEVICE_DATA
+TYPEDEF: PSP_DEVICE_INTERFACE_DATA PSP_INTERFACE_DEVICE_DAT
+CONSTANT: SPID_ACTIVE $ SPINT_ACTIVE
+CONSTANT: SPID_DEFAULT $ SPINT_DEFAULT
+CONSTANT: SPID_REMOVED $ SPINT_REMOVED
+
+STRUCT: SP_DEVICE_INTERFACE_DETAIL_DATA_A
+ { cbSize DWORD }
+ { DevicePath CHAR[ANYSIZE_ARRAY] } ;
+TYPEDEF: SP_DEVICE_INTERFACE_DETAIL_DATA_A* PSP_DEVICE_INTERFACE_DETAIL_DATA_A
+STRUCT: SP_DEVICE_INTERFACE_DETAIL_DATA_W
+ { cbSize DWORD }
+ { DevicePath WCHAR[ANYSIZE_ARRAY] } ;
+TYPEDEF: SP_DEVICE_INTERFACE_DETAIL_DATA_W* PSP_DEVICE_INTERFACE_DETAIL_DATA_W
+TYPEDEF: SP_DEVICE_INTERFACE_DETAIL_DATA_W SP_DEVICE_INTERFACE_DETAIL_DATA
+TYPEDEF: PSP_DEVICE_INTERFACE_DETAIL_DATA_W PSP_DEVICE_INTERFACE_DETAIL_DATA
+TYPEDEF: SP_DEVICE_INTERFACE_DETAIL_DATA_W SP_INTERFACE_DEVICE_DETAIL_DATA_W
+TYPEDEF: PSP_DEVICE_INTERFACE_DETAIL_DATA_W PSP_INTERFACE_DEVICE_DETAIL_DATA_W
+TYPEDEF: SP_DEVICE_INTERFACE_DETAIL_DATA_A SP_INTERFACE_DEVICE_DETAIL_DATA_A
+TYPEDEF: PSP_DEVICE_INTERFACE_DETAIL_DATA_A PSP_INTERFACE_DEVICE_DETAIL_DATA_A
+
+TYPEDEF: SP_INTERFACE_DEVICE_DETAIL_DATA_W SP_INTERFACE_DEVICE_DETAIL_DATA
+TYPEDEF: PSP_INTERFACE_DEVICE_DETAIL_DATA_W PSP_INTERFACE_DEVICE_DETAIL_DATA
+
+STRUCT: SP_DEVINFO_LIST_DETAIL_DATA_A
+ { cbSize DWORD }
+ { ClassGuid GUID }
+ { RemoteMachineHandle HANDLE }
+ { RemoteMachineName CHAR[SP_MAX_MACHINENAME_LENGTH] } ;
+TYPEDEF: SP_DEVINFO_LIST_DETAIL_DATA_A* PSP_DEVINFO_LIST_DETAIL_DATA_A
+STRUCT: SP_DEVINFO_LIST_DETAIL_DATA_W
+ { cbSize DWORD }
+ { ClassGuid GUID }
+ { RemoteMachineHandle HANDLE }
+ { RemoteMachineName WCHAR[SP_MAX_MACHINENAME_LENGTH] } ;
+TYPEDEF: SP_DEVINFO_LIST_DETAIL_DATA_W* PSP_DEVINFO_LIST_DETAIL_DATA_W
+
+TYPEDEF: SP_DEVINFO_LIST_DETAIL_DATA_W SP_DEVINFO_LIST_DETAIL_DATA
+TYPEDEF: PSP_DEVINFO_LIST_DETAIL_DATA_W PSP_DEVINFO_LIST_DETAIL_DATA
+
+CONSTANT: DIF_SELECTDEVICE HEX: 00000001
+CONSTANT: DIF_INSTALLDEVICE HEX: 00000002
+CONSTANT: DIF_ASSIGNRESOURCES HEX: 00000003
+CONSTANT: DIF_PROPERTIES HEX: 00000004
+CONSTANT: DIF_REMOVE HEX: 00000005
+CONSTANT: DIF_FIRSTTIMESETUP HEX: 00000006
+CONSTANT: DIF_FOUNDDEVICE HEX: 00000007
+CONSTANT: DIF_SELECTCLASSDRIVERS HEX: 00000008
+CONSTANT: DIF_VALIDATECLASSDRIVERS HEX: 00000009
+CONSTANT: DIF_INSTALLCLASSDRIVERS HEX: 0000000A
+CONSTANT: DIF_CALCDISKSPACE HEX: 0000000B
+CONSTANT: DIF_DESTROYPRIVATEDATA HEX: 0000000C
+CONSTANT: DIF_VALIDATEDRIVER HEX: 0000000D
+CONSTANT: DIF_DETECT HEX: 0000000F
+CONSTANT: DIF_INSTALLWIZARD HEX: 00000010
+CONSTANT: DIF_DESTROYWIZARDDATA HEX: 00000011
+CONSTANT: DIF_PROPERTYCHANGE HEX: 00000012
+CONSTANT: DIF_ENABLECLASS HEX: 00000013
+CONSTANT: DIF_DETECTVERIFY HEX: 00000014
+CONSTANT: DIF_INSTALLDEVICEFILES HEX: 00000015
+CONSTANT: DIF_UNREMOVE HEX: 00000016
+CONSTANT: DIF_SELECTBESTCOMPATDRV HEX: 00000017
+CONSTANT: DIF_ALLOW_INSTALL HEX: 00000018
+CONSTANT: DIF_REGISTERDEVICE HEX: 00000019
+CONSTANT: DIF_NEWDEVICEWIZARD_PRESELECT HEX: 0000001A
+CONSTANT: DIF_NEWDEVICEWIZARD_SELECT HEX: 0000001B
+CONSTANT: DIF_NEWDEVICEWIZARD_PREANALYZE HEX: 0000001C
+CONSTANT: DIF_NEWDEVICEWIZARD_POSTANALYZE HEX: 0000001D
+CONSTANT: DIF_NEWDEVICEWIZARD_FINISHINSTALL HEX: 0000001E
+CONSTANT: DIF_UNUSED1 HEX: 0000001F
+CONSTANT: DIF_INSTALLINTERFACES HEX: 00000020
+CONSTANT: DIF_DETECTCANCEL HEX: 00000021
+CONSTANT: DIF_REGISTER_COINSTALLERS HEX: 00000022
+CONSTANT: DIF_ADDPROPERTYPAGE_ADVANCED HEX: 00000023
+CONSTANT: DIF_ADDPROPERTYPAGE_BASIC HEX: 00000024
+CONSTANT: DIF_RESERVED1 HEX: 00000025
+CONSTANT: DIF_TROUBLESHOOTER HEX: 00000026
+CONSTANT: DIF_POWERMESSAGEWAKE HEX: 00000027
+CONSTANT: DIF_ADDREMOTEPROPERTYPAGE_ADVANCED HEX: 00000028
+CONSTANT: DIF_UPDATEDRIVER_UI HEX: 00000029
+CONSTANT: DIF_FINISHINSTALL_ACTION HEX: 0000002A
+CONSTANT: DIF_RESERVED2 HEX: 00000030
+CONSTANT: DIF_MOVEDEVICE HEX: 0000000E
+TYPEDEF: UINT DI_FUNCTION
+
+STRUCT: SP_DEVINSTALL_PARAMS_A
+ { cbSize DWORD }
+ { Flags DWORD }
+ { FlagsEx DWORD }
+ { hwndParent HWND }
+ { InstallMsgHandler PSP_FILE_CALLBACK }
+ { InstallMsgHandlerContext PVOID }
+ { FileQueue HSPFILEQ }
+ { ClassInstallReserved ULONG_PTR }
+ { Reserved DWORD }
+ { DriverPath CHAR[MAX_PATH] } ;
+TYPEDEF: SP_DEVINSTALL_PARAMS_A* PSP_DEVINSTALL_PARAMS_A
+STRUCT: SP_DEVINSTALL_PARAMS_W
+ { cbSize DWORD }
+ { Flags DWORD }
+ { FlagsEx DWORD }
+ { hwndParent HWND }
+ { InstallMsgHandler PSP_FILE_CALLBACK }
+ { InstallMsgHandlerContext PVOID }
+ { FileQueue HSPFILEQ }
+ { ClassInstallReserved ULONG_PTR }
+ { Reserved DWORD }
+ { DriverPath WCHAR[MAX_PATH] } ;
+TYPEDEF: SP_DEVINSTALL_PARAMS_W* PSP_DEVINSTALL_PARAMS_W
+TYPEDEF: SP_DEVINSTALL_PARAMS_W SP_DEVINSTALL_PARAMS
+TYPEDEF: PSP_DEVINSTALL_PARAMS_W PSP_DEVINSTALL_PARAMS
+
+CONSTANT: DI_SHOWOEM HEX: 00000001
+CONSTANT: DI_SHOWCOMPAT HEX: 00000002
+CONSTANT: DI_SHOWCLASS HEX: 00000004
+CONSTANT: DI_SHOWALL HEX: 00000007
+CONSTANT: DI_NOVCP HEX: 00000008
+CONSTANT: DI_DIDCOMPAT HEX: 00000010
+CONSTANT: DI_DIDCLASS HEX: 00000020
+CONSTANT: DI_AUTOASSIGNRES HEX: 00000040
+CONSTANT: DI_NEEDRESTART HEX: 00000080
+CONSTANT: DI_NEEDREBOOT HEX: 00000100
+CONSTANT: DI_NOBROWSE HEX: 00000200
+CONSTANT: DI_MULTMFGS HEX: 00000400
+CONSTANT: DI_DISABLED HEX: 00000800
+CONSTANT: DI_GENERALPAGE_ADDED HEX: 00001000
+CONSTANT: DI_RESOURCEPAGE_ADDED HEX: 00002000
+CONSTANT: DI_PROPERTIES_CHANGE HEX: 00004000
+CONSTANT: DI_INF_IS_SORTED HEX: 00008000
+CONSTANT: DI_ENUMSINGLEINF HEX: 00010000
+CONSTANT: DI_DONOTCALLCONFIGMG HEX: 00020000
+CONSTANT: DI_INSTALLDISABLED HEX: 00040000
+CONSTANT: DI_COMPAT_FROM_CLASS HEX: 00080000
+CONSTANT: DI_CLASSINSTALLPARAMS HEX: 00100000
+CONSTANT: DI_NODI_DEFAULTACTION HEX: 00200000
+CONSTANT: DI_QUIETINSTALL HEX: 00800000
+CONSTANT: DI_NOFILECOPY HEX: 01000000
+CONSTANT: DI_FORCECOPY HEX: 02000000
+CONSTANT: DI_DRIVERPAGE_ADDED HEX: 04000000
+CONSTANT: DI_USECI_SELECTSTRINGS HEX: 08000000
+CONSTANT: DI_OVERRIDE_INFFLAGS HEX: 10000000
+CONSTANT: DI_PROPS_NOCHANGEUSAGE HEX: 20000000
+CONSTANT: DI_NOSELECTICONS HEX: 40000000
+CONSTANT: DI_NOWRITE_IDS HEX: 80000000
+CONSTANT: DI_FLAGSEX_RESERVED2 HEX: 00000001
+CONSTANT: DI_FLAGSEX_RESERVED3 HEX: 00000002
+CONSTANT: DI_FLAGSEX_CI_FAILED HEX: 00000004
+CONSTANT: DI_FLAGSEX_FINISHINSTALL_ACTION HEX: 00000008
+CONSTANT: DI_FLAGSEX_DIDINFOLIST HEX: 00000010
+CONSTANT: DI_FLAGSEX_DIDCOMPATINFO HEX: 00000020
+CONSTANT: DI_FLAGSEX_FILTERCLASSES HEX: 00000040
+CONSTANT: DI_FLAGSEX_SETFAILEDINSTALL HEX: 00000080
+CONSTANT: DI_FLAGSEX_DEVICECHANGE HEX: 00000100
+CONSTANT: DI_FLAGSEX_ALWAYSWRITEIDS HEX: 00000200
+CONSTANT: DI_FLAGSEX_PROPCHANGE_PENDING HEX: 00000400
+CONSTANT: DI_FLAGSEX_ALLOWEXCLUDEDDRVS HEX: 00000800
+CONSTANT: DI_FLAGSEX_NOUIONQUERYREMOVE HEX: 00001000
+CONSTANT: DI_FLAGSEX_USECLASSFORCOMPAT HEX: 00002000
+CONSTANT: DI_FLAGSEX_RESERVED4 HEX: 00004000
+CONSTANT: DI_FLAGSEX_NO_DRVREG_MODIFY HEX: 00008000
+CONSTANT: DI_FLAGSEX_IN_SYSTEM_SETUP HEX: 00010000
+CONSTANT: DI_FLAGSEX_INET_DRIVER HEX: 00020000
+CONSTANT: DI_FLAGSEX_APPENDDRIVERLIST HEX: 00040000
+CONSTANT: DI_FLAGSEX_PREINSTALLBACKUP HEX: 00080000
+CONSTANT: DI_FLAGSEX_BACKUPONREPLACE HEX: 00100000
+CONSTANT: DI_FLAGSEX_DRIVERLIST_FROM_URL HEX: 00200000
+CONSTANT: DI_FLAGSEX_RESERVED1 HEX: 00400000
+CONSTANT: DI_FLAGSEX_EXCLUDE_OLD_INET_DRIVERS HEX: 00800000
+CONSTANT: DI_FLAGSEX_POWERPAGE_ADDED HEX: 01000000
+CONSTANT: DI_FLAGSEX_FILTERSIMILARDRIVERS HEX: 02000000
+CONSTANT: DI_FLAGSEX_INSTALLEDDRIVER HEX: 04000000
+CONSTANT: DI_FLAGSEX_NO_CLASSLIST_NODE_MERGE HEX: 08000000
+CONSTANT: DI_FLAGSEX_ALTPLATFORM_DRVSEARCH HEX: 10000000
+CONSTANT: DI_FLAGSEX_RESTART_DEVICE_ONLY HEX: 20000000
+CONSTANT: DI_FLAGSEX_RECURSIVESEARCH HEX: 40000000
+CONSTANT: DI_FLAGSEX_SEARCH_PUBLISHED_INFS HEX: 80000000
+
+STRUCT: SP_CLASSINSTALL_HEADER
+ { cbSize DWORD }
+ { InstallFunction DI_FUNCTION } ;
+TYPEDEF: SP_CLASSINSTALL_HEADER* PSP_CLASSINSTALL_HEADER
+
+STRUCT: SP_ENABLECLASS_PARAMS
+ { ClassInstallHeader SP_CLASSINSTALL_HEADER }
+ { ClassGuid GUID }
+ { EnableMessage DWORD } ;
+TYPEDEF: SP_ENABLECLASS_PARAMS* PSP_ENABLECLASS_PARAMS
+
+CONSTANT: ENABLECLASS_QUERY 0
+CONSTANT: ENABLECLASS_SUCCESS 1
+CONSTANT: ENABLECLASS_FAILURE 2
+CONSTANT: DICS_ENABLE HEX: 00000001
+CONSTANT: DICS_DISABLE HEX: 00000002
+CONSTANT: DICS_PROPCHANGE HEX: 00000003
+CONSTANT: DICS_START HEX: 00000004
+CONSTANT: DICS_STOP HEX: 00000005
+CONSTANT: DICS_FLAG_GLOBAL HEX: 00000001
+CONSTANT: DICS_FLAG_CONFIGSPECIFIC HEX: 00000002
+CONSTANT: DICS_FLAG_CONFIGGENERAL HEX: 00000004
+
+STRUCT: SP_PROPCHANGE_PARAMS
+ { ClassInstallHeader SP_CLASSINSTALL_HEADER }
+ { StateChange DWORD }
+ { Scope DWORD }
+ { HwProfile DWORD } ;
+TYPEDEF: SP_PROPCHANGE_PARAMS* PSP_PROPCHANGE_PARAMS
+
+STRUCT: SP_REMOVEDEVICE_PARAMS
+ { ClassInstallHeader SP_CLASSINSTALL_HEADER }
+ { Scope DWORD }
+ { HwProfile DWORD } ;
+TYPEDEF: SP_REMOVEDEVICE_PARAMS* PSP_REMOVEDEVICE_PARAMS
+
+CONSTANT: DI_REMOVEDEVICE_GLOBAL HEX: 00000001
+CONSTANT: DI_REMOVEDEVICE_CONFIGSPECIFIC HEX: 00000002
+
+STRUCT: SP_UNREMOVEDEVICE_PARAMS
+ { ClassInstallHeader SP_CLASSINSTALL_HEADER }
+ { Scope DWORD }
+ { HwProfile DWORD } ;
+TYPEDEF: SP_UNREMOVEDEVICE_PARAMS* PSP_UNREMOVEDEVICE_PARAMS
+
+CONSTANT: DI_UNREMOVEDEVICE_CONFIGSPECIFIC HEX: 00000002
+
+STRUCT: SP_SELECTDEVICE_PARAMS_A
+ { ClassInstallHeader SP_CLASSINSTALL_HEADER }
+ { Title CHAR[MAX_TITLE_LEN] }
+ { Instructions CHAR[MAX_INSTRUCTION_LEN] }
+ { ListLabel CHAR[MAX_LABEL_LEN] }
+ { SubTitle CHAR[MAX_SUBTITLE_LEN] }
+ { Reserved BYTE[2] } ;
+TYPEDEF: SP_SELECTDEVICE_PARAMS_A* PSP_SELECTDEVICE_PARAMS_A
+STRUCT: SP_SELECTDEVICE_PARAMS_W
+ { ClassInstallHeader SP_CLASSINSTALL_HEADER }
+ { Title WCHAR[MAX_TITLE_LEN] }
+ { Instructions WCHAR[MAX_INSTRUCTION_LEN] }
+ { ListLabel WCHAR[MAX_LABEL_LEN] }
+ { SubTitle WCHAR[MAX_SUBTITLE_LEN] } ;
+TYPEDEF: SP_SELECTDEVICE_PARAMS_W* PSP_SELECTDEVICE_PARAMS_W
+TYPEDEF: SP_SELECTDEVICE_PARAMS_W SP_SELECTDEVICE_PARAMS
+TYPEDEF: PSP_SELECTDEVICE_PARAMS_W PSP_SELECTDEVICE_PARAMS
+
+CALLBACK: BOOL PDETECT_PROGRESS_NOTIFY ( PVOID ProgressNotifyParam, DWORD DetectComplete ) ;
+
+STRUCT: SP_DETECTDEVICE_PARAMS
+ { ClassInstallHeader SP_CLASSINSTALL_HEADER }
+ { DetectProgressNotify PDETECT_PROGRESS_NOTIFY }
+ { ProgressNotifyParam PVOID } ;
+TYPEDEF: SP_DETECTDEVICE_PARAMS* PSP_DETECTDEVICE_PARAMS
+
+CONSTANT: MAX_INSTALLWIZARD_DYNAPAGES 20
+
+STRUCT: SP_INSTALLWIZARD_DATA
+ { ClassInstallHeader SP_CLASSINSTALL_HEADER }
+ { Flags DWORD }
+ { DynamicPages HPROPSHEETPAGE[MAX_INSTALLWIZARD_DYNAPAGES] }
+ { NumDynamicPages DWORD }
+ { DynamicPageFlags DWORD }
+ { PrivateFlags DWORD }
+ { PrivateData LPARAM }
+ { hwndWizardDlg HWND } ;
+TYPEDEF: SP_INSTALLWIZARD_DATA* PSP_INSTALLWIZARD_DATA
+
+CONSTANT: NDW_INSTALLFLAG_DIDFACTDEFS HEX: 00000001
+CONSTANT: NDW_INSTALLFLAG_HARDWAREALLREADYIN HEX: 00000002
+CONSTANT: NDW_INSTALLFLAG_NEEDRESTART $ DI_NEEDRESTART
+CONSTANT: NDW_INSTALLFLAG_NEEDREBOOT $ DI_NEEDREBOOT
+CONSTANT: NDW_INSTALLFLAG_NEEDSHUTDOWN HEX: 00000200
+CONSTANT: NDW_INSTALLFLAG_EXPRESSINTRO HEX: 00000400
+CONSTANT: NDW_INSTALLFLAG_SKIPISDEVINSTALLED HEX: 00000800
+CONSTANT: NDW_INSTALLFLAG_NODETECTEDDEVS HEX: 00001000
+CONSTANT: NDW_INSTALLFLAG_INSTALLSPECIFIC HEX: 00002000
+CONSTANT: NDW_INSTALLFLAG_SKIPCLASSLIST HEX: 00004000
+CONSTANT: NDW_INSTALLFLAG_CI_PICKED_OEM HEX: 00008000
+CONSTANT: NDW_INSTALLFLAG_PCMCIAMODE HEX: 00010000
+CONSTANT: NDW_INSTALLFLAG_PCMCIADEVICE HEX: 00020000
+CONSTANT: NDW_INSTALLFLAG_USERCANCEL HEX: 00040000
+CONSTANT: NDW_INSTALLFLAG_KNOWNCLASS HEX: 00080000
+CONSTANT: DYNAWIZ_FLAG_PAGESADDED HEX: 00000001
+CONSTANT: DYNAWIZ_FLAG_ANALYZE_HANDLECONFLICT HEX: 00000008
+CONSTANT: DYNAWIZ_FLAG_INSTALLDET_NEXT HEX: 00000002
+CONSTANT: DYNAWIZ_FLAG_INSTALLDET_PREV HEX: 00000004
+CONSTANT: MIN_IDD_DYNAWIZ_RESOURCE_ID 10000
+CONSTANT: MAX_IDD_DYNAWIZ_RESOURCE_ID 11000
+CONSTANT: IDD_DYNAWIZ_FIRSTPAGE 10000
+CONSTANT: IDD_DYNAWIZ_SELECT_PREVPAGE 10001
+CONSTANT: IDD_DYNAWIZ_SELECT_NEXTPAGE 10002
+CONSTANT: IDD_DYNAWIZ_ANALYZE_PREVPAGE 10003
+CONSTANT: IDD_DYNAWIZ_ANALYZE_NEXTPAGE 10004
+CONSTANT: IDD_DYNAWIZ_SELECTDEV_PAGE 10009
+CONSTANT: IDD_DYNAWIZ_ANALYZEDEV_PAGE 10010
+CONSTANT: IDD_DYNAWIZ_INSTALLDETECTEDDEVS_PAGE 10011
+CONSTANT: IDD_DYNAWIZ_SELECTCLASS_PAGE 10012
+CONSTANT: IDD_DYNAWIZ_INSTALLDETECTED_PREVPAGE 10006
+CONSTANT: IDD_DYNAWIZ_INSTALLDETECTED_NEXTPAGE 10007
+CONSTANT: IDD_DYNAWIZ_INSTALLDETECTED_NODEVS 10008
+
+STRUCT: SP_NEWDEVICEWIZARD_DATA
+ { ClassInstallHeader SP_CLASSINSTALL_HEADER }
+ { Flags DWORD }
+ { DynamicPages HPROPSHEETPAGE[MAX_INSTALLWIZARD_DYNAPAGES] }
+ { NumDynamicPages DWORD }
+ { hwndWizardDlg HWND } ;
+TYPEDEF: SP_NEWDEVICEWIZARD_DATA* PSP_NEWDEVICEWIZARD_DATA
+TYPEDEF: SP_NEWDEVICEWIZARD_DATA SP_ADDPROPERTYPAGE_DATA
+TYPEDEF: PSP_NEWDEVICEWIZARD_DATA PSP_ADDPROPERTYPAGE_DATA
+
+STRUCT: SP_TROUBLESHOOTER_PARAMS_A
+ { ClassInstallHeader SP_CLASSINSTALL_HEADER }
+ { ChmFile CHAR[MAX_PATH] }
+ { HtmlTroubleShooter CHAR[MAX_PATH] } ;
+TYPEDEF: SP_TROUBLESHOOTER_PARAMS_A* PSP_TROUBLESHOOTER_PARAMS_A
+STRUCT: SP_TROUBLESHOOTER_PARAMS_W
+ { ClassInstallHeader SP_CLASSINSTALL_HEADER }
+ { ChmFile WCHAR[MAX_PATH] }
+ { HtmlTroubleShooter WCHAR[MAX_PATH] } ;
+TYPEDEF: SP_TROUBLESHOOTER_PARAMS_W* PSP_TROUBLESHOOTER_PARAMS_W
+TYPEDEF: SP_TROUBLESHOOTER_PARAMS_W SP_TROUBLESHOOTER_PARAMS
+TYPEDEF: PSP_TROUBLESHOOTER_PARAMS_W PSP_TROUBLESHOOTER_PARAMS
+
+STRUCT: SP_POWERMESSAGEWAKE_PARAMS_A
+ { ClassInstallHeader SP_CLASSINSTALL_HEADER }
+ { PowerMessageWake CHAR[LINE_LEN*2] } ;
+TYPEDEF: SP_POWERMESSAGEWAKE_PARAMS_A* PSP_POWERMESSAGEWAKE_PARAMS_A
+STRUCT: SP_POWERMESSAGEWAKE_PARAMS_W
+ { ClassInstallHeader SP_CLASSINSTALL_HEADER }
+ { PowerMessageWake WCHAR[LINE_LEN*2] } ;
+TYPEDEF: SP_POWERMESSAGEWAKE_PARAMS_W* PSP_POWERMESSAGEWAKE_PARAMS_W
+TYPEDEF: SP_POWERMESSAGEWAKE_PARAMS_W SP_POWERMESSAGEWAKE_PARAMS
+TYPEDEF: PSP_POWERMESSAGEWAKE_PARAMS_W PSP_POWERMESSAGEWAKE_PARAMS
+
+STRUCT: SP_DRVINFO_DATA_V2_A
+ { cbSize DWORD }
+ { DriverType DWORD }
+ { Reserved ULONG_PTR }
+ { Description CHAR[LINE_LEN] }
+ { MfgName CHAR[LINE_LEN] }
+ { ProviderName CHAR[LINE_LEN] }
+ { DriverDate FILETIME }
+ { DriverVersion DWORDLONG } ;
+TYPEDEF: SP_DRVINFO_DATA_V2_A* PSP_DRVINFO_DATA_V2_A
+STRUCT: SP_DRVINFO_DATA_V2_W
+ { cbSize DWORD }
+ { DriverType DWORD }
+ { Reserved ULONG_PTR }
+ { Description WCHAR[LINE_LEN] }
+ { MfgName WCHAR[LINE_LEN] }
+ { ProviderName WCHAR[LINE_LEN] }
+ { DriverDate FILETIME }
+ { DriverVersion DWORDLONG } ;
+TYPEDEF: SP_DRVINFO_DATA_V2_W* PSP_DRVINFO_DATA_V2_W
+STRUCT: SP_DRVINFO_DATA_V1_A
+ { cbSize DWORD }
+ { DriverType DWORD }
+ { Reserved ULONG_PTR }
+ { Description CHAR[LINE_LEN] }
+ { MfgName CHAR[LINE_LEN] }
+ { ProviderName CHAR[LINE_LEN] } ;
+TYPEDEF: SP_DRVINFO_DATA_V1_A* PSP_DRVINFO_DATA_V1_A
+STRUCT: SP_DRVINFO_DATA_V1_W
+ { cbSize DWORD }
+ { DriverType DWORD }
+ { Reserved ULONG_PTR }
+ { Description WCHAR[LINE_LEN] }
+ { MfgName WCHAR[LINE_LEN] }
+ { ProviderName WCHAR[LINE_LEN] } ;
+TYPEDEF: SP_DRVINFO_DATA_V1_W* PSP_DRVINFO_DATA_V1_W
+TYPEDEF: SP_DRVINFO_DATA_V1_W SP_DRVINFO_DATA_V1
+TYPEDEF: PSP_DRVINFO_DATA_V1_W PSP_DRVINFO_DATA_V1
+TYPEDEF: SP_DRVINFO_DATA_V2_W SP_DRVINFO_DATA_V2
+TYPEDEF: PSP_DRVINFO_DATA_V2_W PSP_DRVINFO_DATA_V2
+TYPEDEF: SP_DRVINFO_DATA_V2_A SP_DRVINFO_DATA_A
+TYPEDEF: PSP_DRVINFO_DATA_V2_A PSP_DRVINFO_DATA_A
+TYPEDEF: SP_DRVINFO_DATA_V2_W SP_DRVINFO_DATA_W
+TYPEDEF: PSP_DRVINFO_DATA_V2_W PSP_DRVINFO_DATA_W
+TYPEDEF: SP_DRVINFO_DATA_V2 SP_DRVINFO_DATA
+TYPEDEF: PSP_DRVINFO_DATA_V2 PSP_DRVINFO_DATA
+
+STRUCT: SP_DRVINFO_DETAIL_DATA_A
+ { cbSize DWORD }
+ { InfDate FILETIME }
+ { CompatIDsOffset DWORD }
+ { CompatIDsLength DWORD }
+ { Reserved ULONG_PTR }
+ { SectionName CHAR[LINE_LEN] }
+ { InfFileName CHAR[MAX_PATH] }
+ { DrvDescription CHAR[LINE_LEN] }
+ { HardwareID CHAR[ANYSIZE_ARRAY] } ;
+TYPEDEF: SP_DRVINFO_DETAIL_DATA_A* PSP_DRVINFO_DETAIL_DATA_A
+STRUCT: SP_DRVINFO_DETAIL_DATA_W
+ { cbSize DWORD }
+ { InfDate FILETIME }
+ { CompatIDsOffset DWORD }
+ { CompatIDsLength DWORD }
+ { Reserved ULONG_PTR }
+ { SectionName WCHAR[LINE_LEN] }
+ { InfFileName WCHAR[MAX_PATH] }
+ { DrvDescription WCHAR[LINE_LEN] }
+ { HardwareID WCHAR[ANYSIZE_ARRAY] } ;
+TYPEDEF: SP_DRVINFO_DETAIL_DATA_W* PSP_DRVINFO_DETAIL_DATA_W
+
+TYPEDEF: SP_DRVINFO_DETAIL_DATA_W SP_DRVINFO_DETAIL_DATA
+TYPEDEF: PSP_DRVINFO_DETAIL_DATA_W PSP_DRVINFO_DETAIL_DATA
+
+STRUCT: SP_DRVINSTALL_PARAMS
+ { cbSize DWORD }
+ { Rank DWORD }
+ { Flags DWORD }
+ { PrivateData DWORD_PTR }
+ { Reserved DWORD } ;
+TYPEDEF: SP_DRVINSTALL_PARAMS* PSP_DRVINSTALL_PARAMS
+
+CONSTANT: DNF_DUPDESC HEX: 00000001
+CONSTANT: DNF_OLDDRIVER HEX: 00000002
+CONSTANT: DNF_EXCLUDEFROMLIST HEX: 00000004
+CONSTANT: DNF_NODRIVER HEX: 00000008
+CONSTANT: DNF_LEGACYINF HEX: 00000010
+CONSTANT: DNF_CLASS_DRIVER HEX: 00000020
+CONSTANT: DNF_COMPATIBLE_DRIVER HEX: 00000040
+CONSTANT: DNF_INET_DRIVER HEX: 00000080
+CONSTANT: DNF_UNUSED1 HEX: 00000100
+CONSTANT: DNF_UNUSED2 HEX: 00000200
+CONSTANT: DNF_OLD_INET_DRIVER HEX: 00000400
+CONSTANT: DNF_BAD_DRIVER HEX: 00000800
+CONSTANT: DNF_DUPPROVIDER HEX: 00001000
+CONSTANT: DNF_INF_IS_SIGNED HEX: 00002000
+CONSTANT: DNF_OEM_F6_INF HEX: 00004000
+CONSTANT: DNF_DUPDRIVERVER HEX: 00008000
+CONSTANT: DNF_BASIC_DRIVER HEX: 00010000
+CONSTANT: DNF_AUTHENTICODE_SIGNED HEX: 00020000
+CONSTANT: DNF_INSTALLEDDRIVER HEX: 00040000
+CONSTANT: DNF_ALWAYSEXCLUDEFROMLIST HEX: 00080000
+CONSTANT: DNF_INBOX_DRIVER HEX: 00100000
+CONSTANT: DNF_REQUESTADDITIONALSOFTWARE HEX: 00200000
+CONSTANT: DNF_UNUSED_22 HEX: 00400000
+CONSTANT: DNF_UNUSED_23 HEX: 00800000
+CONSTANT: DNF_UNUSED_24 HEX: 01000000
+CONSTANT: DNF_UNUSED_25 HEX: 02000000
+CONSTANT: DNF_UNUSED_26 HEX: 04000000
+CONSTANT: DNF_UNUSED_27 HEX: 08000000
+CONSTANT: DNF_UNUSED_28 HEX: 10000000
+CONSTANT: DNF_UNUSED_29 HEX: 20000000
+CONSTANT: DNF_UNUSED_30 HEX: 40000000
+CONSTANT: DNF_UNUSED_31 HEX: 80000000
+CONSTANT: DRIVER_HARDWAREID_RANK HEX: 00000FFF
+CONSTANT: DRIVER_HARDWAREID_MASK HEX: 80000FFF
+CONSTANT: DRIVER_UNTRUSTED_RANK HEX: 80000000
+CONSTANT: DRIVER_W9X_SUSPECT_RANK HEX: C0000000
+
+CALLBACK: DWORD PSP_DETSIG_CMPPROC ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA NewDeviceData, PSP_DEVINFO_DATA ExistingDeviceData, PVOID CompareContext ) ;
+
+STRUCT: COINSTALLER_CONTEXT_DATA
+ { PostProcessing BOOL }
+ { InstallResult DWORD }
+ { PrivateData PVOID } ;
+TYPEDEF: COINSTALLER_CONTEXT_DATA* PCOINSTALLER_CONTEXT_DATA
+
+STRUCT: SP_CLASSIMAGELIST_DATA
+ { cbSize DWORD }
+ { ImageList HIMAGELIST }
+ { Reserved ULONG_PTR } ;
+TYPEDEF: SP_CLASSIMAGELIST_DATA* PSP_CLASSIMAGELIST_DATA
+
+STRUCT: SP_PROPSHEETPAGE_REQUEST
+ { cbSize DWORD }
+ { PageRequested DWORD }
+ { DeviceInfoSet HDEVINFO }
+ { DeviceInfoData PSP_DEVINFO_DATA } ;
+TYPEDEF: SP_PROPSHEETPAGE_REQUEST* PSP_PROPSHEETPAGE_REQUEST
+
+CONSTANT: SPPSR_SELECT_DEVICE_RESOURCES 1
+CONSTANT: SPPSR_ENUM_BASIC_DEVICE_PROPERTIES 2
+CONSTANT: SPPSR_ENUM_ADV_DEVICE_PROPERTIES 3
+
+STRUCT: SP_BACKUP_QUEUE_PARAMS_V2_A
+ { cbSize DWORD }
+ { FullInfPath CHAR[MAX_PATH] }
+ { FilenameOffset INT }
+ { ReinstallInstance CHAR[MAX_PATH] } ;
+TYPEDEF: SP_BACKUP_QUEUE_PARAMS_V2_A* PSP_BACKUP_QUEUE_PARAMS_V2_A
+
+STRUCT: SP_BACKUP_QUEUE_PARAMS_V2_W
+ { cbSize DWORD }
+ { FullInfPath WCHAR[MAX_PATH] }
+ { FilenameOffset INT }
+ { ReinstallInstance WCHAR[MAX_PATH] } ;
+TYPEDEF: SP_BACKUP_QUEUE_PARAMS_V2_W* PSP_BACKUP_QUEUE_PARAMS_V2_W
+
+STRUCT: SP_BACKUP_QUEUE_PARAMS_V1_A
+ { cbSize DWORD }
+ { FullInfPath CHAR[MAX_PATH] }
+ { FilenameOffset INT } ;
+TYPEDEF: SP_BACKUP_QUEUE_PARAMS_V1_A* PSP_BACKUP_QUEUE_PARAMS_V1_A
+
+STRUCT: SP_BACKUP_QUEUE_PARAMS_V1_W
+ { cbSize DWORD }
+ { FullInfPath WCHAR[MAX_PATH] }
+ { FilenameOffset INT } ;
+TYPEDEF: SP_BACKUP_QUEUE_PARAMS_V1_W* PSP_BACKUP_QUEUE_PARAMS_V1_W
+
+TYPEDEF: SP_BACKUP_QUEUE_PARAMS_V1_W SP_BACKUP_QUEUE_PARAMS_V1
+TYPEDEF: PSP_BACKUP_QUEUE_PARAMS_V1_W PSP_BACKUP_QUEUE_PARAMS_V1
+TYPEDEF: SP_BACKUP_QUEUE_PARAMS_V2_W SP_BACKUP_QUEUE_PARAMS_V2
+TYPEDEF: PSP_BACKUP_QUEUE_PARAMS_V2_W PSP_BACKUP_QUEUE_PARAMS_V2
+TYPEDEF: SP_BACKUP_QUEUE_PARAMS_V2_A SP_BACKUP_QUEUE_PARAMS_A
+TYPEDEF: PSP_BACKUP_QUEUE_PARAMS_V2_A PSP_BACKUP_QUEUE_PARAMS_A
+TYPEDEF: SP_BACKUP_QUEUE_PARAMS_V2_W SP_BACKUP_QUEUE_PARAMS_W
+TYPEDEF: PSP_BACKUP_QUEUE_PARAMS_V2_W PSP_BACKUP_QUEUE_PARAMS_W
+TYPEDEF: SP_BACKUP_QUEUE_PARAMS_V2 SP_BACKUP_QUEUE_PARAMS
+TYPEDEF: PSP_BACKUP_QUEUE_PARAMS_V2 PSP_BACKUP_QUEUE_PARAMS
+
+CONSTANT: ERROR_EXPECTED_SECTION_NAME $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR 0 bitor bitor ]
+CONSTANT: ERROR_BAD_SECTION_NAME_LINE $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR 1 bitor bitor ]
+CONSTANT: ERROR_SECTION_NAME_TOO_LONG $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR 2 bitor bitor ]
+CONSTANT: ERROR_GENERAL_SYNTAX $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR 3 bitor bitor ]
+CONSTANT: ERROR_WRONG_INF_STYLE $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 100 bitor bitor ]
+CONSTANT: ERROR_SECTION_NOT_FOUND $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 101 bitor bitor ]
+CONSTANT: ERROR_LINE_NOT_FOUND $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 102 bitor bitor ]
+CONSTANT: ERROR_NO_BACKUP $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 103 bitor bitor ]
+CONSTANT: ERROR_NO_ASSOCIATED_CLASS $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 200 bitor bitor ]
+CONSTANT: ERROR_CLASS_MISMATCH $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 201 bitor bitor ]
+CONSTANT: ERROR_DUPLICATE_FOUND $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 202 bitor bitor ]
+CONSTANT: ERROR_NO_DRIVER_SELECTED $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 203 bitor bitor ]
+CONSTANT: ERROR_KEY_DOES_NOT_EXIST $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 204 bitor bitor ]
+CONSTANT: ERROR_INVALID_DEVINST_NAME $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 205 bitor bitor ]
+CONSTANT: ERROR_INVALID_CLASS $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 206 bitor bitor ]
+CONSTANT: ERROR_DEVINST_ALREADY_EXISTS $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 207 bitor bitor ]
+CONSTANT: ERROR_DEVINFO_NOT_REGISTERED $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 208 bitor bitor ]
+CONSTANT: ERROR_INVALID_REG_PROPERTY $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 209 bitor bitor ]
+CONSTANT: ERROR_NO_INF $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 20A bitor bitor ]
+CONSTANT: ERROR_NO_SUCH_DEVINST $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 20B bitor bitor ]
+CONSTANT: ERROR_CANT_LOAD_CLASS_ICON $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 20C bitor bitor ]
+CONSTANT: ERROR_INVALID_CLASS_INSTALLER $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 20D bitor bitor ]
+CONSTANT: ERROR_DI_DO_DEFAULT $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 20E bitor bitor ]
+CONSTANT: ERROR_DI_NOFILECOPY $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 20F bitor bitor ]
+CONSTANT: ERROR_INVALID_HWPROFILE $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 210 bitor bitor ]
+CONSTANT: ERROR_NO_DEVICE_SELECTED $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 211 bitor bitor ]
+CONSTANT: ERROR_DEVINFO_LIST_LOCKED $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 212 bitor bitor ]
+CONSTANT: ERROR_DEVINFO_DATA_LOCKED $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 213 bitor bitor ]
+CONSTANT: ERROR_DI_BAD_PATH $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 214 bitor bitor ]
+CONSTANT: ERROR_NO_CLASSINSTALL_PARAMS $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 215 bitor bitor ]
+CONSTANT: ERROR_FILEQUEUE_LOCKED $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 216 bitor bitor ]
+CONSTANT: ERROR_BAD_SERVICE_INSTALLSECT $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 217 bitor bitor ]
+CONSTANT: ERROR_NO_CLASS_DRIVER_LIST $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 218 bitor bitor ]
+CONSTANT: ERROR_NO_ASSOCIATED_SERVICE $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 219 bitor bitor ]
+CONSTANT: ERROR_NO_DEFAULT_DEVICE_INTERFACE $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 21A bitor bitor ]
+CONSTANT: ERROR_DEVICE_INTERFACE_ACTIVE $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 21B bitor bitor ]
+CONSTANT: ERROR_DEVICE_INTERFACE_REMOVED $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 21C bitor bitor ]
+CONSTANT: ERROR_BAD_INTERFACE_INSTALLSECT $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 21D bitor bitor ]
+CONSTANT: ERROR_NO_SUCH_INTERFACE_CLASS $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 21E bitor bitor ]
+CONSTANT: ERROR_INVALID_REFERENCE_STRING $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 21F bitor bitor ]
+CONSTANT: ERROR_INVALID_MACHINENAME $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 220 bitor bitor ]
+CONSTANT: ERROR_REMOTE_COMM_FAILURE $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 221 bitor bitor ]
+CONSTANT: ERROR_MACHINE_UNAVAILABLE $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 222 bitor bitor ]
+CONSTANT: ERROR_NO_CONFIGMGR_SERVICES $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 223 bitor bitor ]
+CONSTANT: ERROR_INVALID_PROPPAGE_PROVIDER $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 224 bitor bitor ]
+CONSTANT: ERROR_NO_SUCH_DEVICE_INTERFACE $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 225 bitor bitor ]
+CONSTANT: ERROR_DI_POSTPROCESSING_REQUIRED $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 226 bitor bitor ]
+CONSTANT: ERROR_INVALID_COINSTALLER $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 227 bitor bitor ]
+CONSTANT: ERROR_NO_COMPAT_DRIVERS $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 228 bitor bitor ]
+CONSTANT: ERROR_NO_DEVICE_ICON $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 229 bitor bitor ]
+CONSTANT: ERROR_INVALID_INF_LOGCONFIG $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 22A bitor bitor ]
+CONSTANT: ERROR_DI_DONT_INSTALL $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 22B bitor bitor ]
+CONSTANT: ERROR_INVALID_FILTER_DRIVER $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 22C bitor bitor ]
+CONSTANT: ERROR_NON_WINDOWS_NT_DRIVER $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 22D bitor bitor ]
+CONSTANT: ERROR_NON_WINDOWS_DRIVER $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 22E bitor bitor ]
+CONSTANT: ERROR_NO_CATALOG_FOR_OEM_INF $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 22F bitor bitor ]
+CONSTANT: ERROR_DEVINSTALL_QUEUE_NONNATIVE $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 230 bitor bitor ]
+CONSTANT: ERROR_NOT_DISABLEABLE $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 231 bitor bitor ]
+CONSTANT: ERROR_CANT_REMOVE_DEVINST $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 232 bitor bitor ]
+CONSTANT: ERROR_INVALID_TARGET $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 233 bitor bitor ]
+CONSTANT: ERROR_DRIVER_NONNATIVE $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 234 bitor bitor ]
+CONSTANT: ERROR_IN_WOW64 $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 235 bitor bitor ]
+CONSTANT: ERROR_SET_SYSTEM_RESTORE_POINT $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 236 bitor bitor ]
+CONSTANT: ERROR_SCE_DISABLED $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 238 bitor bitor ]
+CONSTANT: ERROR_UNKNOWN_EXCEPTION $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 239 bitor bitor ]
+CONSTANT: ERROR_PNP_REGISTRY_ERROR $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 23A bitor bitor ]
+CONSTANT: ERROR_REMOTE_REQUEST_UNSUPPORTED $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 23B bitor bitor ]
+CONSTANT: ERROR_NOT_AN_INSTALLED_OEM_INF $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 23C bitor bitor ]
+CONSTANT: ERROR_INF_IN_USE_BY_DEVICES $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 23D bitor bitor ]
+CONSTANT: ERROR_DI_FUNCTION_OBSOLETE $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 23E bitor bitor ]
+CONSTANT: ERROR_NO_AUTHENTICODE_CATALOG $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 23F bitor bitor ]
+CONSTANT: ERROR_AUTHENTICODE_DISALLOWED $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 240 bitor bitor ]
+CONSTANT: ERROR_AUTHENTICODE_TRUSTED_PUBLISHER $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 241 bitor bitor ]
+CONSTANT: ERROR_AUTHENTICODE_TRUST_NOT_ESTABLISHED $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 242 bitor bitor ]
+CONSTANT: ERROR_AUTHENTICODE_PUBLISHER_NOT_TRUSTED $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 243 bitor bitor ]
+CONSTANT: ERROR_SIGNATURE_OSATTRIBUTE_MISMATCH $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 244 bitor bitor ]
+CONSTANT: ERROR_ONLY_VALIDATE_VIA_AUTHENTICODE $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 245 bitor bitor ]
+CONSTANT: ERROR_DEVICE_INSTALLER_NOT_READY $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 246 bitor bitor ]
+CONSTANT: ERROR_DRIVER_STORE_ADD_FAILED $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 247 bitor bitor ]
+CONSTANT: ERROR_DEVICE_INSTALL_BLOCKED $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 248 bitor bitor ]
+CONSTANT: ERROR_DRIVER_INSTALL_BLOCKED $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 249 bitor bitor ]
+CONSTANT: ERROR_WRONG_INF_TYPE $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 24A bitor bitor ]
+CONSTANT: ERROR_FILE_HASH_NOT_IN_CATALOG $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 24B bitor bitor ]
+CONSTANT: ERROR_DRIVER_STORE_DELETE_FAILED $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 24C bitor bitor ]
+CONSTANT: ERROR_UNRECOVERABLE_STACK_OVERFLOW $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 300 bitor bitor ]
+CONSTANT: EXCEPTION_SPAPI_UNRECOVERABLE_STACK_OVERFLOW $ ERROR_UNRECOVERABLE_STACK_OVERFLOW
+CONSTANT: ERROR_NO_DEFAULT_INTERFACE_DEVICE $ ERROR_NO_DEFAULT_DEVICE_INTERFACE
+CONSTANT: ERROR_INTERFACE_DEVICE_ACTIVE $ ERROR_DEVICE_INTERFACE_ACTIVE
+CONSTANT: ERROR_INTERFACE_DEVICE_REMOVED $ ERROR_DEVICE_INTERFACE_REMOVED
+CONSTANT: ERROR_NO_SUCH_INTERFACE_DEVICE $ ERROR_NO_SUCH_DEVICE_INTERFACE
+CONSTANT: ERROR_NOT_INSTALLED $[ APPLICATION_ERROR_MASK ERROR_SEVERITY_ERROR HEX: 1000 bitor bitor ]
+
+FUNCTION: BOOL SetupGetInfInformationA ( LPCVOID InfSpec, DWORD SearchControl, PSP_INF_INFORMATION ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupGetInfInformationW ( LPCVOID InfSpec, DWORD SearchControl, PSP_INF_INFORMATION ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+CONSTANT: INFINFO_INF_SPEC_IS_HINF 1
+CONSTANT: INFINFO_INF_NAME_IS_ABSOLUTE 2
+CONSTANT: INFINFO_DEFAULT_SEARCH 3
+CONSTANT: INFINFO_REVERSE_DEFAULT_SEARCH 4
+CONSTANT: INFINFO_INF_PATH_LIST_SEARCH 5
+ALIAS: SetupGetInfInformation SetupGetInfInformationW
+
+FUNCTION: BOOL SetupQueryInfFileInformationA ( PSP_INF_INFORMATION InfInformation, UINT InfIndex, PSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupQueryInfFileInformationW ( PSP_INF_INFORMATION InfInformation, UINT InfIndex, PWSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+ALIAS: SetupQueryInfFileInformation SetupQueryInfFileInformationW
+
+FUNCTION: BOOL SetupQueryInfOriginalFileInformationA ( PSP_INF_INFORMATION InfInformation, UINT InfIndex, PSP_ALTPLATFORM_INFO AlternatePlatformInfo, PSP_ORIGINAL_FILE_INFO_A OriginalFileInfo ) ;
+FUNCTION: BOOL SetupQueryInfOriginalFileInformationW ( PSP_INF_INFORMATION InfInformation, UINT InfIndex, PSP_ALTPLATFORM_INFO AlternatePlatformInfo, PSP_ORIGINAL_FILE_INFO_W OriginalFileInfo ) ;
+ALIAS: SetupQueryInfOriginalFileInformation SetupQueryInfOriginalFileInformationW
+
+FUNCTION: BOOL SetupQueryInfVersionInformationA ( PSP_INF_INFORMATION InfInformation, UINT InfIndex, PCSTR Key, PSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupQueryInfVersionInformationW ( PSP_INF_INFORMATION InfInformation, UINT InfIndex, PCWSTR Key, PWSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+ALIAS: SetupQueryInfVersionInformation SetupQueryInfVersionInformationW
+
+FUNCTION: BOOL SetupGetInfDriverStoreLocationA ( PCSTR FileName, PSP_ALTPLATFORM_INFO AlternatePlatformInfo, PCSTR LocaleName, PSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupGetInfDriverStoreLocationW ( PCWSTR FileName, PSP_ALTPLATFORM_INFO AlternatePlatformInfo, PCWSTR LocaleName, PWSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+ALIAS: SetupGetInfDriverStoreLocation SetupGetInfDriverStoreLocationW
+
+FUNCTION: BOOL SetupGetInfPublishedNameA ( PCSTR DriverStoreLocation, PSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupGetInfPublishedNameW ( PCWSTR DriverStoreLocation, PWSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+ALIAS: SetupGetInfPublishedName SetupGetInfPublishedNameW
+
+FUNCTION: BOOL SetupGetInfFileListA ( PCSTR DirectoryPath, DWORD InfStyle, PSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupGetInfFileListW ( PCWSTR DirectoryPath, DWORD InfStyle, PWSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+ALIAS: SetupGetInfFileList SetupGetInfFileListW
+
+FUNCTION: HINF SetupOpenInfFileW ( PCWSTR FileName, PCWSTR InfClass, DWORD InfStyle, PUINT ErrorLine ) ;
+FUNCTION: HINF SetupOpenInfFileA ( PCSTR FileName, PCSTR InfClass, DWORD InfStyle, PUINT ErrorLine ) ;
+ALIAS: SetupOpenInfFile SetupOpenInfFileW
+
+FUNCTION: HINF SetupOpenMasterInf ( ) ;
+
+FUNCTION: BOOL SetupOpenAppendInfFileW ( PCWSTR FileName, HINF InfHandle, PUINT ErrorLine ) ;
+FUNCTION: BOOL SetupOpenAppendInfFileA ( PCSTR FileName, HINF InfHandle, PUINT ErrorLine ) ;
+ALIAS: SetupOpenAppendInfFile SetupOpenAppendInfFileW
+
+FUNCTION: void SetupCloseInfFile ( HINF InfHandle ) ;
+FUNCTION: BOOL SetupFindFirstLineA ( HINF InfHandle, PCSTR Section, PCSTR Key, PINFCONTEXT Context ) ;
+FUNCTION: BOOL SetupFindFirstLineW ( HINF InfHandle, PCWSTR Section, PCWSTR Key, PINFCONTEXT Context ) ;
+ALIAS: SetupFindFirstLine SetupFindFirstLineW
+
+FUNCTION: BOOL SetupFindNextLine ( PINFCONTEXT ContextIn, PINFCONTEXT ContextOut ) ;
+FUNCTION: BOOL SetupFindNextMatchLineA ( PINFCONTEXT ContextIn, PCSTR Key, PINFCONTEXT ContextOut ) ;
+FUNCTION: BOOL SetupFindNextMatchLineW ( PINFCONTEXT ContextIn, PCWSTR Key, PINFCONTEXT ContextOut ) ;
+ALIAS: SetupFindNextMatchLine SetupFindNextMatchLineW
+
+FUNCTION: BOOL SetupGetLineByIndexA ( HINF InfHandle, PCSTR Section, DWORD Index, PINFCONTEXT Context ) ;
+FUNCTION: BOOL SetupGetLineByIndexW ( HINF InfHandle, PCWSTR Section, DWORD Index, PINFCONTEXT Context ) ;
+ALIAS: SetupGetLineByIndex SetupGetLineByIndexW
+
+FUNCTION: LONG SetupGetLineCountA ( HINF InfHandle, PCSTR Section ) ;
+FUNCTION: LONG SetupGetLineCountW ( HINF InfHandle, PCWSTR Section ) ;
+ALIAS: SetupGetLineCount SetupGetLineCountW
+
+FUNCTION: BOOL SetupGetLineTextA ( PINFCONTEXT Context, HINF InfHandle, PCSTR Section, PCSTR Key, PSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupGetLineTextW ( PINFCONTEXT Context, HINF InfHandle, PCWSTR Section, PCWSTR Key, PWSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+ALIAS: SetupGetLineText SetupGetLineTextW
+
+FUNCTION: DWORD SetupGetFieldCount ( PINFCONTEXT Context ) ;
+FUNCTION: BOOL SetupGetStringFieldA ( PINFCONTEXT Context, DWORD FieldIndex, PSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupGetStringFieldW ( PINFCONTEXT Context, DWORD FieldIndex, PWSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+ALIAS: SetupGetStringField SetupGetStringFieldW
+
+FUNCTION: BOOL SetupGetIntField ( PINFCONTEXT Context, DWORD FieldIndex, PINT IntegerValue ) ;
+FUNCTION: BOOL SetupGetMultiSzFieldA ( PINFCONTEXT Context, DWORD FieldIndex, PSTR ReturnBuffer, DWORD ReturnBufferSize, LPDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupGetMultiSzFieldW ( PINFCONTEXT Context, DWORD FieldIndex, PWSTR ReturnBuffer, DWORD ReturnBufferSize, LPDWORD RequiredSize ) ;
+ALIAS: SetupGetMultiSzField SetupGetMultiSzFieldW
+
+FUNCTION: BOOL SetupGetBinaryField ( PINFCONTEXT Context, DWORD FieldIndex, PBYTE ReturnBuffer, DWORD ReturnBufferSize, LPDWORD RequiredSize ) ;
+FUNCTION: DWORD SetupGetFileCompressionInfoA ( PCSTR SourceFileName, PSTR* ActualSourceFileName, PDWORD SourceFileSize, PDWORD TargetFileSize, PUINT CompressionType ) ;
+FUNCTION: DWORD SetupGetFileCompressionInfoW ( PCWSTR SourceFileName, PWSTR* ActualSourceFileName, PDWORD SourceFileSize, PDWORD TargetFileSize, PUINT CompressionType ) ;
+ALIAS: SetupGetFileCompressionInfo SetupGetFileCompressionInfoW
+
+FUNCTION: BOOL SetupGetFileCompressionInfoExA ( PCSTR SourceFileName, PSTR ActualSourceFileNameBuffer, DWORD ActualSourceFileNameBufferLen, PDWORD RequiredBufferLen, PDWORD SourceFileSize, PDWORD TargetFileSize, PUINT CompressionType ) ;
+FUNCTION: BOOL SetupGetFileCompressionInfoExW ( PCWSTR SourceFileName, PWSTR ActualSourceFileNameBuffer, DWORD ActualSourceFileNameBufferLen, PDWORD RequiredBufferLen, PDWORD SourceFileSize, PDWORD TargetFileSize, PUINT CompressionType ) ;
+ALIAS: SetupGetFileCompressionInfoEx SetupGetFileCompressionInfoExW
+
+CONSTANT: FILE_COMPRESSION_NONE 0
+CONSTANT: FILE_COMPRESSION_WINLZA 1
+CONSTANT: FILE_COMPRESSION_MSZIP 2
+CONSTANT: FILE_COMPRESSION_NTCAB 3
+
+FUNCTION: DWORD SetupDecompressOrCopyFileA ( PCSTR SourceFileName, PCSTR TargetFileName, PUINT CompressionType ) ;
+FUNCTION: DWORD SetupDecompressOrCopyFileW ( PCWSTR SourceFileName, PCWSTR TargetFileName, PUINT CompressionType ) ;
+ALIAS: SetupDecompressOrCopyFile SetupDecompressOrCopyFileW
+
+FUNCTION: BOOL SetupGetSourceFileLocationA ( HINF InfHandle, PINFCONTEXT InfContext, PCSTR FileName, PUINT SourceId, PSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupGetSourceFileLocationW ( HINF InfHandle, PINFCONTEXT InfContext, PCWSTR FileName, PUINT SourceId, PWSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+ALIAS: SetupGetSourceFileLocation SetupGetSourceFileLocationW
+
+FUNCTION: BOOL SetupGetSourceFileSizeA ( HINF InfHandle, PINFCONTEXT InfContext, PCSTR FileName, PCSTR Section, PDWORD FileSize, UINT RoundingFactor ) ;
+FUNCTION: BOOL SetupGetSourceFileSizeW ( HINF InfHandle, PINFCONTEXT InfContext, PCWSTR FileName, PCWSTR Section, PDWORD FileSize, UINT RoundingFactor ) ;
+ALIAS: SetupGetSourceFileSize SetupGetSourceFileSizeW
+
+FUNCTION: BOOL SetupGetTargetPathA ( HINF InfHandle, PINFCONTEXT InfContext, PCSTR Section, PSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupGetTargetPathW ( HINF InfHandle, PINFCONTEXT InfContext, PCWSTR Section, PWSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+ALIAS: SetupGetTargetPath SetupGetTargetPathW
+
+CONSTANT: SRCLIST_TEMPORARY HEX: 00000001
+CONSTANT: SRCLIST_NOBROWSE HEX: 00000002
+CONSTANT: SRCLIST_SYSTEM HEX: 00000010
+CONSTANT: SRCLIST_USER HEX: 00000020
+CONSTANT: SRCLIST_SYSIFADMIN HEX: 00000040
+CONSTANT: SRCLIST_SUBDIRS HEX: 00000100
+CONSTANT: SRCLIST_APPEND HEX: 00000200
+CONSTANT: SRCLIST_NOSTRIPPLATFORM HEX: 00000400
+
+FUNCTION: BOOL SetupSetSourceListA ( DWORD Flags, PCSTR* SourceList, UINT SourceCount ) ;
+FUNCTION: BOOL SetupSetSourceListW ( DWORD Flags, PCWSTR* SourceList, UINT SourceCount ) ;
+ALIAS: SetupSetSourceList SetupSetSourceListW
+
+FUNCTION: BOOL SetupCancelTemporarySourceList( ) ;
+FUNCTION: BOOL SetupAddToSourceListA ( DWORD Flags, PCSTR Source ) ;
+FUNCTION: BOOL SetupAddToSourceListW ( DWORD Flags, PCWSTR Source ) ;
+ALIAS: SetupAddToSourceList SetupAddToSourceListW
+
+FUNCTION: BOOL SetupRemoveFromSourceListA ( DWORD Flags, PCSTR Source ) ;
+FUNCTION: BOOL SetupRemoveFromSourceListW ( DWORD Flags, PCWSTR Source ) ;
+ALIAS: SetupRemoveFromSourceList SetupRemoveFromSourceListW
+
+FUNCTION: BOOL SetupQuerySourceListA ( DWORD Flags, PCSTR** List, PUINT Count ) ;
+FUNCTION: BOOL SetupQuerySourceListW ( DWORD Flags, PCWSTR** List, PUINT Count ) ;
+ALIAS: SetupQuerySourceList SetupQuerySourceListW
+
+FUNCTION: BOOL SetupFreeSourceListA ( PCSTR** List, UINT Count ) ;
+FUNCTION: BOOL SetupFreeSourceListW ( PCWSTR** List, UINT Count ) ;
+ALIAS: SetupFreeSourceList SetupFreeSourceListW
+
+FUNCTION: UINT SetupPromptForDiskA ( HWND hwndParent, PCSTR DialogTitle, PCSTR DiskName, PCSTR PathToSource, PCSTR FileSought, PCSTR TagFile, DWORD DiskPromptStyle, PSTR PathBuffer, DWORD PathBufferSize, PDWORD PathRequiredSize ) ;
+FUNCTION: UINT SetupPromptForDiskW ( HWND hwndParent, PCWSTR DialogTitle, PCWSTR DiskName, PCWSTR PathToSource, PCWSTR FileSought, PCWSTR TagFile, DWORD DiskPromptStyle, PWSTR PathBuffer, DWORD PathBufferSize, PDWORD PathRequiredSize ) ;
+ALIAS: SetupPromptForDisk SetupPromptForDiskW
+
+FUNCTION: UINT SetupCopyErrorA ( HWND hwndParent, PCSTR DialogTitle, PCSTR DiskName, PCSTR PathToSource, PCSTR SourceFile, PCSTR TargetPathFile, UINT Win32ErrorCode, DWORD Style, PSTR PathBuffer, DWORD PathBufferSize, PDWORD PathRequiredSize ) ;
+FUNCTION: UINT SetupCopyErrorW ( HWND hwndParent, PCWSTR DialogTitle, PCWSTR DiskName, PCWSTR PathToSource, PCWSTR SourceFile, PCWSTR TargetPathFile, UINT Win32ErrorCode, DWORD Style, PWSTR PathBuffer, DWORD PathBufferSize, PDWORD PathRequiredSize ) ;
+ALIAS: SetupCopyError SetupCopyErrorW
+
+FUNCTION: UINT SetupRenameErrorA ( HWND hwndParent, PCSTR DialogTitle, PCSTR SourceFile, PCSTR TargetFile, UINT Win32ErrorCode, DWORD Style ) ;
+FUNCTION: UINT SetupRenameErrorW ( HWND hwndParent, PCWSTR DialogTitle, PCWSTR SourceFile, PCWSTR TargetFile, UINT Win32ErrorCode, DWORD Style ) ;
+ALIAS: SetupRenameError SetupRenameErrorW
+
+FUNCTION: UINT SetupDeleteErrorA ( HWND hwndParent, PCSTR DialogTitle, PCSTR File, UINT Win32ErrorCode, DWORD Style ) ;
+FUNCTION: UINT SetupDeleteErrorW ( HWND hwndParent, PCWSTR DialogTitle, PCWSTR File, UINT Win32ErrorCode, DWORD Style ) ;
+ALIAS: SetupDeleteError SetupDeleteErrorW
+
+FUNCTION: UINT SetupBackupErrorA ( HWND hwndParent, PCSTR DialogTitle, PCSTR SourceFile, PCSTR TargetFile, UINT Win32ErrorCode, DWORD Style ) ;
+FUNCTION: UINT SetupBackupErrorW ( HWND hwndParent, PCWSTR DialogTitle, PCWSTR SourceFile, PCWSTR TargetFile, UINT Win32ErrorCode, DWORD Style ) ;
+ALIAS: SetupBackupError SetupBackupErrorW
+
+CONSTANT: IDF_NOBROWSE HEX: 00000001
+CONSTANT: IDF_NOSKIP HEX: 00000002
+CONSTANT: IDF_NODETAILS HEX: 00000004
+CONSTANT: IDF_NOCOMPRESSED HEX: 00000008
+CONSTANT: IDF_CHECKFIRST HEX: 00000100
+CONSTANT: IDF_NOBEEP HEX: 00000200
+CONSTANT: IDF_NOFOREGROUND HEX: 00000400
+CONSTANT: IDF_WARNIFSKIP HEX: 00000800
+CONSTANT: IDF_NOREMOVABLEMEDIAPROMPT HEX: 00001000
+CONSTANT: IDF_USEDISKNAMEASPROMPT HEX: 00002000
+CONSTANT: IDF_OEMDISK HEX: 80000000
+
+CONSTANT: DPROMPT_SUCCESS 0
+CONSTANT: DPROMPT_CANCEL 1
+CONSTANT: DPROMPT_SKIPFILE 2
+CONSTANT: DPROMPT_BUFFERTOOSMALL 3
+CONSTANT: DPROMPT_OUTOFMEMORY 4
+
+FUNCTION: BOOL SetupSetDirectoryIdA ( HINF InfHandle, DWORD Id, PCSTR Directory ) ;
+FUNCTION: BOOL SetupSetDirectoryIdW ( HINF InfHandle, DWORD Id, PCWSTR Directory ) ;
+ALIAS: SetupSetDirectoryId SetupSetDirectoryIdW
+
+FUNCTION: BOOL SetupSetDirectoryIdExA ( HINF InfHandle, DWORD Id, PCSTR Directory, DWORD Flags, DWORD Reserved1, PVOID Reserved2 ) ;
+FUNCTION: BOOL SetupSetDirectoryIdExW ( HINF InfHandle, DWORD Id, PCWSTR Directory, DWORD Flags, DWORD Reserved1, PVOID Reserved2 ) ;
+ALIAS: SetupSetDirectoryIdEx SetupSetDirectoryIdExW
+
+CONSTANT: SETDIRID_NOT_FULL_PATH HEX: 00000001
+
+FUNCTION: BOOL SetupGetSourceInfoA ( HINF InfHandle, UINT SourceId, UINT InfoDesired, PSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupGetSourceInfoW ( HINF InfHandle, UINT SourceId, UINT InfoDesired, PWSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+ALIAS: SetupGetSourceInfo SetupGetSourceInfoW
+
+CONSTANT: SRCINFO_PATH 1
+CONSTANT: SRCINFO_TAGFILE 2
+CONSTANT: SRCINFO_DESCRIPTION 3
+CONSTANT: SRCINFO_FLAGS 4
+CONSTANT: SRCINFO_TAGFILE2 5
+CONSTANT: SRC_FLAGS_CABFILE HEX: 0010
+
+FUNCTION: BOOL SetupInstallFileA ( HINF InfHandle, PINFCONTEXT InfContext, PCSTR SourceFile, PCSTR SourcePathRoot, PCSTR DestinationName, DWORD CopyStyle, PSP_FILE_CALLBACK_A CopyMsgHandler, PVOID Context ) ;
+FUNCTION: BOOL SetupInstallFileW ( HINF InfHandle, PINFCONTEXT InfContext, PCWSTR SourceFile, PCWSTR SourcePathRoot, PCWSTR DestinationName, DWORD CopyStyle, PSP_FILE_CALLBACK_W CopyMsgHandler, PVOID Context ) ;
+ALIAS: SetupInstallFile SetupInstallFileW
+
+FUNCTION: BOOL SetupInstallFileExA ( HINF InfHandle, PINFCONTEXT InfContext, PCSTR SourceFile, PCSTR SourcePathRoot, PCSTR DestinationName, DWORD CopyStyle, PSP_FILE_CALLBACK_A CopyMsgHandler, PVOID Context, PBOOL FileWasInUse ) ;
+FUNCTION: BOOL SetupInstallFileExW ( HINF InfHandle, PINFCONTEXT InfContext, PCWSTR SourceFile, PCWSTR SourcePathRoot, PCWSTR DestinationName, DWORD CopyStyle, PSP_FILE_CALLBACK_W CopyMsgHandler, PVOID Context, PBOOL FileWasInUse ) ;
+ALIAS: SetupInstallFileEx SetupInstallFileExW
+
+CONSTANT: SP_COPY_DELETESOURCE HEX: 0000001
+CONSTANT: SP_COPY_REPLACEONLY HEX: 0000002
+CONSTANT: SP_COPY_NEWER HEX: 0000004
+CONSTANT: SP_COPY_NEWER_OR_SAME $ SP_COPY_NEWER
+CONSTANT: SP_COPY_NOOVERWRITE HEX: 0000008
+CONSTANT: SP_COPY_NODECOMP HEX: 0000010
+CONSTANT: SP_COPY_LANGUAGEAWARE HEX: 0000020
+CONSTANT: SP_COPY_SOURCE_ABSOLUTE HEX: 0000040
+CONSTANT: SP_COPY_SOURCEPATH_ABSOLUTE HEX: 0000080
+CONSTANT: SP_COPY_IN_USE_NEEDS_REBOOT HEX: 0000100
+CONSTANT: SP_COPY_FORCE_IN_USE HEX: 0000200
+CONSTANT: SP_COPY_NOSKIP HEX: 0000400
+CONSTANT: SP_FLAG_CABINETCONTINUATION HEX: 0000800
+CONSTANT: SP_COPY_FORCE_NOOVERWRITE HEX: 0001000
+CONSTANT: SP_COPY_FORCE_NEWER HEX: 0002000
+CONSTANT: SP_COPY_WARNIFSKIP HEX: 0004000
+CONSTANT: SP_COPY_NOBROWSE HEX: 0008000
+CONSTANT: SP_COPY_NEWER_ONLY HEX: 0010000
+CONSTANT: SP_COPY_RESERVED HEX: 0020000
+CONSTANT: SP_COPY_OEMINF_CATALOG_ONLY HEX: 0040000
+CONSTANT: SP_COPY_REPLACE_BOOT_FILE HEX: 0080000
+CONSTANT: SP_COPY_NOPRUNE HEX: 0100000
+CONSTANT: SP_COPY_OEM_F6_INF HEX: 0200000
+CONSTANT: SP_COPY_ALREADYDECOMP HEX: 0400000
+CONSTANT: SP_COPY_WINDOWS_SIGNED HEX: 1000000
+CONSTANT: SP_COPY_PNPLOCKED HEX: 2000000
+CONSTANT: SP_COPY_IN_USE_TRY_RENAME HEX: 4000000
+CONSTANT: SP_COPY_INBOX_INF HEX: 8000000
+CONSTANT: SP_COPY_HARDLINK HEX: 10000000
+
+CONSTANT: SP_BACKUP_BACKUPPASS HEX: 00000001
+CONSTANT: SP_BACKUP_DEMANDPASS HEX: 00000002
+CONSTANT: SP_BACKUP_SPECIAL HEX: 00000004
+CONSTANT: SP_BACKUP_BOOTFILE HEX: 00000008
+
+FUNCTION: HSPFILEQ SetupOpenFileQueue ( ) ;
+FUNCTION: BOOL SetupCloseFileQueue ( HSPFILEQ QueueHandle ) ;
+FUNCTION: BOOL SetupSetFileQueueAlternatePlatformA ( HSPFILEQ QueueHandle, PSP_ALTPLATFORM_INFO AlternatePlatformInfo, PCSTR AlternateDefaultCatalogFile ) ;
+FUNCTION: BOOL SetupSetFileQueueAlternatePlatformW ( HSPFILEQ QueueHandle, PSP_ALTPLATFORM_INFO AlternatePlatformInfo, PCWSTR AlternateDefaultCatalogFile ) ;
+ALIAS: SetupSetFileQueueAlternatePlatform SetupSetFileQueueAlternatePlatformW
+
+FUNCTION: BOOL SetupSetPlatformPathOverrideA ( PCSTR Override ) ;
+FUNCTION: BOOL SetupSetPlatformPathOverrideW ( PCWSTR Override ) ;
+ALIAS: SetupSetPlatformPathOverride SetupSetPlatformPathOverrideW
+
+FUNCTION: BOOL SetupQueueCopyA ( HSPFILEQ QueueHandle, PCSTR SourceRootPath, PCSTR SourcePath, PCSTR SourceFilename, PCSTR SourceDescription, PCSTR SourceTagfile, PCSTR TargetDirectory, PCSTR TargetFilename, DWORD CopyStyle ) ;
+FUNCTION: BOOL SetupQueueCopyW ( HSPFILEQ QueueHandle, PCWSTR SourceRootPath, PCWSTR SourcePath, PCWSTR SourceFilename, PCWSTR SourceDescription, PCWSTR SourceTagfile, PCWSTR TargetDirectory, PCWSTR TargetFilename, DWORD CopyStyle ) ;
+ALIAS: SetupQueueCopy SetupQueueCopyW
+
+FUNCTION: BOOL SetupQueueCopyIndirectA ( PSP_FILE_COPY_PARAMS_A CopyParams ) ;
+FUNCTION: BOOL SetupQueueCopyIndirectW ( PSP_FILE_COPY_PARAMS_W CopyParams ) ;
+ALIAS: SetupQueueCopyIndirect SetupQueueCopyIndirectW
+
+FUNCTION: BOOL SetupQueueDefaultCopyA ( HSPFILEQ QueueHandle, HINF InfHandle, PCSTR SourceRootPath, PCSTR SourceFilename, PCSTR TargetFilename, DWORD CopyStyle ) ;
+FUNCTION: BOOL SetupQueueDefaultCopyW ( HSPFILEQ QueueHandle, HINF InfHandle, PCWSTR SourceRootPath, PCWSTR SourceFilename, PCWSTR TargetFilename, DWORD CopyStyle ) ;
+ALIAS: SetupQueueDefaultCopy SetupQueueDefaultCopyW
+
+FUNCTION: BOOL SetupQueueCopySectionA ( HSPFILEQ QueueHandle, PCSTR SourceRootPath, HINF InfHandle, HINF ListInfHandle, PCSTR Section, DWORD CopyStyle ) ;
+FUNCTION: BOOL SetupQueueCopySectionW ( HSPFILEQ QueueHandle, PCWSTR SourceRootPath, HINF InfHandle, HINF ListInfHandle, PCWSTR Section, DWORD CopyStyle ) ;
+ALIAS: SetupQueueCopySection SetupQueueCopySectionW
+
+FUNCTION: BOOL SetupQueueDeleteA ( HSPFILEQ QueueHandle, PCSTR PathPart1, PCSTR PathPart2 ) ;
+FUNCTION: BOOL SetupQueueDeleteW ( HSPFILEQ QueueHandle, PCWSTR PathPart1, PCWSTR PathPart2 ) ;
+ALIAS: SetupQueueDelete SetupQueueDeleteW
+
+FUNCTION: BOOL SetupQueueDeleteSectionA ( HSPFILEQ QueueHandle, HINF InfHandle, HINF ListInfHandle, PCSTR Section ) ;
+FUNCTION: BOOL SetupQueueDeleteSectionW ( HSPFILEQ QueueHandle, HINF InfHandle, HINF ListInfHandle, PCWSTR Section ) ;
+ALIAS: SetupQueueDeleteSection SetupQueueDeleteSectionW
+
+FUNCTION: BOOL SetupQueueRenameA ( HSPFILEQ QueueHandle, PCSTR SourcePath, PCSTR SourceFilename, PCSTR TargetPath, PCSTR TargetFilename ) ;
+FUNCTION: BOOL SetupQueueRenameW ( HSPFILEQ QueueHandle, PCWSTR SourcePath, PCWSTR SourceFilename, PCWSTR TargetPath, PCWSTR TargetFilename ) ;
+ALIAS: SetupQueueRename SetupQueueRenameW
+
+FUNCTION: BOOL SetupQueueRenameSectionA ( HSPFILEQ QueueHandle, HINF InfHandle, HINF ListInfHandle, PCSTR Section ) ;
+FUNCTION: BOOL SetupQueueRenameSectionW ( HSPFILEQ QueueHandle, HINF InfHandle, HINF ListInfHandle, PCWSTR Section ) ;
+ALIAS: SetupQueueRenameSection SetupQueueRenameSectionW
+
+FUNCTION: BOOL SetupCommitFileQueueA ( HWND Owner, HSPFILEQ QueueHandle, PSP_FILE_CALLBACK_A MsgHandler, PVOID Context ) ;
+FUNCTION: BOOL SetupCommitFileQueueW ( HWND Owner, HSPFILEQ QueueHandle, PSP_FILE_CALLBACK_W MsgHandler, PVOID Context ) ;
+ALIAS: SetupCommitFileQueue SetupCommitFileQueueW
+
+FUNCTION: BOOL SetupScanFileQueueA ( HSPFILEQ FileQueue, DWORD Flags, HWND Window, PSP_FILE_CALLBACK_A CallbackRoutine, PVOID CallbackContext, PDWORD Result ) ;
+FUNCTION: BOOL SetupScanFileQueueW ( HSPFILEQ FileQueue, DWORD Flags, HWND Window, PSP_FILE_CALLBACK_W CallbackRoutine, PVOID CallbackContext, PDWORD Result ) ;
+ALIAS: SetupScanFileQueue SetupScanFileQueueW
+
+CONSTANT: SPQ_SCAN_FILE_PRESENCE HEX: 00000001
+CONSTANT: SPQ_SCAN_FILE_VALIDITY HEX: 00000002
+CONSTANT: SPQ_SCAN_USE_CALLBACK HEX: 00000004
+CONSTANT: SPQ_SCAN_USE_CALLBACKEX HEX: 00000008
+CONSTANT: SPQ_SCAN_INFORM_USER HEX: 00000010
+CONSTANT: SPQ_SCAN_PRUNE_COPY_QUEUE HEX: 00000020
+CONSTANT: SPQ_SCAN_USE_CALLBACK_SIGNERINFO HEX: 00000040
+CONSTANT: SPQ_SCAN_PRUNE_DELREN HEX: 00000080
+CONSTANT: SPQ_SCAN_FILE_PRESENCE_WITHOUT_SOURCE HEX: 00000100
+CONSTANT: SPQ_SCAN_FILE_COMPARISON HEX: 00000200
+CONSTANT: SPQ_SCAN_ACTIVATE_DRP HEX: 00000400
+CONSTANT: SPQ_DELAYED_COPY HEX: 00000001
+
+FUNCTION: BOOL SetupGetFileQueueCount ( HSPFILEQ FileQueue, UINT SubQueueFileOp, PUINT NumOperations ) ;
+FUNCTION: BOOL SetupGetFileQueueFlags ( HSPFILEQ FileQueue, PDWORD Flags ) ;
+FUNCTION: BOOL SetupSetFileQueueFlags ( HSPFILEQ FileQueue, DWORD FlagMask, DWORD Flags ) ;
+
+CONSTANT: SPQ_FLAG_BACKUP_AWARE HEX: 00000001
+CONSTANT: SPQ_FLAG_ABORT_IF_UNSIGNED HEX: 00000002
+CONSTANT: SPQ_FLAG_FILES_MODIFIED HEX: 00000004
+CONSTANT: SPQ_FLAG_DO_SHUFFLEMOVE HEX: 00000008
+CONSTANT: SPQ_FLAG_VALID HEX: 0000000F
+
+CONSTANT: SPOST_NONE 0
+CONSTANT: SPOST_PATH 1
+CONSTANT: SPOST_URL 2
+CONSTANT: SPOST_MAX 3
+
+FUNCTION: BOOL SetupCopyOEMInfA ( PCSTR SourceInfFileName, PCSTR OEMSourceMediaLocation, DWORD OEMSourceMediaType, DWORD CopyStyle, PSTR DestinationInfFileName, DWORD DestinationInfFileNameSize, PDWORD RequiredSize, PSTR* DestinationInfFileNameComponent ) ;
+FUNCTION: BOOL SetupCopyOEMInfW ( PCWSTR SourceInfFileName, PCWSTR OEMSourceMediaLocation, DWORD OEMSourceMediaType, DWORD CopyStyle, PWSTR DestinationInfFileName, DWORD DestinationInfFileNameSize, PDWORD RequiredSize, PWSTR* DestinationInfFileNameComponent ) ;
+ALIAS: SetupCopyOEMInf SetupCopyOEMInfW
+
+CONSTANT: SUOI_FORCEDELETE HEX: 00000001
+CONSTANT: SUOI_INTERNAL1 HEX: 00000002
+
+FUNCTION: BOOL SetupUninstallOEMInfA ( PCSTR InfFileName, DWORD Flags, PVOID Reserved ) ;
+FUNCTION: BOOL SetupUninstallOEMInfW ( PCWSTR InfFileName, DWORD Flags, PVOID Reserved ) ;
+ALIAS: SetupUninstallOEMInf SetupUninstallOEMInfW
+
+FUNCTION: BOOL SetupUninstallNewlyCopiedInfs( HSPFILEQ FileQueue, DWORD Flags, PVOID Reserved ) ;
+
+FUNCTION: HDSKSPC SetupCreateDiskSpaceListA ( PVOID Reserved1, DWORD Reserved2, UINT Flags ) ;
+FUNCTION: HDSKSPC SetupCreateDiskSpaceListW ( PVOID Reserved1, DWORD Reserved2, UINT Flags ) ;
+ALIAS: SetupCreateDiskSpaceList SetupCreateDiskSpaceListW
+
+CONSTANT: SPDSL_IGNORE_DISK HEX: 00000001
+CONSTANT: SPDSL_DISALLOW_NEGATIVE_ADJUST HEX: 00000002
+
+FUNCTION: HDSKSPC SetupDuplicateDiskSpaceListA ( HDSKSPC DiskSpace, PVOID Reserved1, DWORD Reserved2, UINT Flags ) ;
+FUNCTION: HDSKSPC SetupDuplicateDiskSpaceListW ( HDSKSPC DiskSpace, PVOID Reserved1, DWORD Reserved2, UINT Flags ) ;
+ALIAS: SetupDuplicateDiskSpaceList SetupDuplicateDiskSpaceListW
+
+FUNCTION: BOOL SetupDestroyDiskSpaceList( HDSKSPC DiskSpace ) ;
+FUNCTION: BOOL SetupQueryDrivesInDiskSpaceListA ( HDSKSPC DiskSpace, PSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupQueryDrivesInDiskSpaceListW ( HDSKSPC DiskSpace, PWSTR ReturnBuffer, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+ALIAS: SetupQueryDrivesInDiskSpaceList SetupQueryDrivesInDiskSpaceListW
+
+FUNCTION: BOOL SetupQuerySpaceRequiredOnDriveA ( HDSKSPC DiskSpace, PCSTR DriveSpec, LONGLONG* SpaceRequired, PVOID Reserved1, UINT Reserved2 ) ;
+FUNCTION: BOOL SetupQuerySpaceRequiredOnDriveW ( HDSKSPC DiskSpace, PCWSTR DriveSpec, LONGLONG* SpaceRequired, PVOID Reserved1, UINT Reserved2 ) ;
+ALIAS: SetupQuerySpaceRequiredOnDrive SetupQuerySpaceRequiredOnDriveW
+
+FUNCTION: BOOL SetupAdjustDiskSpaceListA ( HDSKSPC DiskSpace, LPCSTR DriveRoot, LONGLONG Amount, PVOID Reserved1, UINT Reserved2 ) ;
+FUNCTION: BOOL SetupAdjustDiskSpaceListW ( HDSKSPC DiskSpace, LPCWSTR DriveRoot, LONGLONG Amount, PVOID Reserved1, UINT Reserved2 ) ;
+ALIAS: SetupAdjustDiskSpaceList SetupAdjustDiskSpaceListW
+
+FUNCTION: BOOL SetupAddToDiskSpaceListA ( HDSKSPC DiskSpace, PCSTR TargetFilespec, LONGLONG FileSize, UINT Operation, PVOID Reserved1, UINT Reserved2 ) ;
+FUNCTION: BOOL SetupAddToDiskSpaceListW ( HDSKSPC DiskSpace, PCWSTR TargetFilespec, LONGLONG FileSize, UINT Operation, PVOID Reserved1, UINT Reserved2 ) ;
+ALIAS: SetupAddToDiskSpaceList SetupAddToDiskSpaceListW
+
+FUNCTION: BOOL SetupAddSectionToDiskSpaceListA ( HDSKSPC DiskSpace, HINF InfHandle, HINF ListInfHandle, PCSTR SectionName, UINT Operation, PVOID Reserved1, UINT Reserved2 ) ;
+FUNCTION: BOOL SetupAddSectionToDiskSpaceListW ( HDSKSPC DiskSpace, HINF InfHandle, HINF ListInfHandle, PCWSTR SectionName, UINT Operation, PVOID Reserved1, UINT Reserved2 ) ;
+ALIAS: SetupAddSectionToDiskSpaceList SetupAddSectionToDiskSpaceListW
+
+FUNCTION: BOOL SetupAddInstallSectionToDiskSpaceListA ( HDSKSPC DiskSpace, HINF InfHandle, HINF LayoutInfHandle, PCSTR SectionName, PVOID Reserved1, UINT Reserved2 ) ;
+FUNCTION: BOOL SetupAddInstallSectionToDiskSpaceListW ( HDSKSPC DiskSpace, HINF InfHandle, HINF LayoutInfHandle, PCWSTR SectionName, PVOID Reserved1, UINT Reserved2 ) ;
+ALIAS: SetupAddInstallSectionToDiskSpaceList SetupAddInstallSectionToDiskSpaceListW
+
+FUNCTION: BOOL SetupRemoveFromDiskSpaceListA ( HDSKSPC DiskSpace, PCSTR TargetFilespec, UINT Operation, PVOID Reserved1, UINT Reserved2 ) ;
+FUNCTION: BOOL SetupRemoveFromDiskSpaceListW ( HDSKSPC DiskSpace, PCWSTR TargetFilespec, UINT Operation, PVOID Reserved1, UINT Reserved2 ) ;
+ALIAS: SetupRemoveFromDiskSpaceList SetupRemoveFromDiskSpaceListW
+
+FUNCTION: BOOL SetupRemoveSectionFromDiskSpaceListA ( HDSKSPC DiskSpace, HINF InfHandle, HINF ListInfHandle, PCSTR SectionName, UINT Operation, PVOID Reserved1, UINT Reserved2 ) ;
+FUNCTION: BOOL SetupRemoveSectionFromDiskSpaceListW ( HDSKSPC DiskSpace, HINF InfHandle, HINF ListInfHandle, PCWSTR SectionName, UINT Operation, PVOID Reserved1, UINT Reserved2 ) ;
+ALIAS: SetupRemoveSectionFromDiskSpaceList SetupRemoveSectionFromDiskSpaceListW
+
+FUNCTION: BOOL SetupRemoveInstallSectionFromDiskSpaceListA ( HDSKSPC DiskSpace, HINF InfHandle, HINF LayoutInfHandle, PCSTR SectionName, PVOID Reserved1, UINT Reserved2 ) ;
+FUNCTION: BOOL SetupRemoveInstallSectionFromDiskSpaceListW ( HDSKSPC DiskSpace, HINF InfHandle, HINF LayoutInfHandle, PCWSTR SectionName, PVOID Reserved1, UINT Reserved2 ) ;
+ALIAS: SetupRemoveInstallSectionFromDiskSpaceList SetupRemoveInstallSectionFromDiskSpaceListW
+
+FUNCTION: BOOL SetupIterateCabinetA ( PCSTR CabinetFile, DWORD Reserved, PSP_FILE_CALLBACK_A MsgHandler, PVOID Context ) ;
+FUNCTION: BOOL SetupIterateCabinetW ( PCWSTR CabinetFile, DWORD Reserved, PSP_FILE_CALLBACK_W MsgHandler, PVOID Context ) ;
+ALIAS: SetupIterateCabinet SetupIterateCabinetW
+
+FUNCTION: INT SetupPromptReboot ( HSPFILEQ FileQueue, HWND Owner, BOOL ScanOnly ) ;
+
+CONSTANT: SPFILEQ_FILE_IN_USE HEX: 00000001
+CONSTANT: SPFILEQ_REBOOT_RECOMMENDED HEX: 00000002
+CONSTANT: SPFILEQ_REBOOT_IN_PROGRESS HEX: 00000004
+
+FUNCTION: PVOID SetupInitDefaultQueueCallback ( HWND OwnerWindow ) ;
+FUNCTION: PVOID SetupInitDefaultQueueCallbackEx ( HWND OwnerWindow, HWND AlternateProgressWindow, UINT ProgressMessage, DWORD Reserved1, PVOID Reserved2 ) ;
+FUNCTION: void SetupTermDefaultQueueCallback ( PVOID Context ) ;
+
+FUNCTION: UINT SetupDefaultQueueCallbackA ( PVOID Context, UINT Notification, UINT_PTR Param1, UINT_PTR Param2 ) ;
+FUNCTION: UINT SetupDefaultQueueCallbackW ( PVOID Context, UINT Notification, UINT_PTR Param1, UINT_PTR Param2 ) ;
+ALIAS: SetupDefaultQueueCallback SetupDefaultQueueCallbackW
+
+CONSTANT: FLG_ADDREG_DELREG_BIT HEX: 00008000
+CONSTANT: FLG_ADDREG_BINVALUETYPE HEX: 00000001
+CONSTANT: FLG_ADDREG_NOCLOBBER HEX: 00000002
+CONSTANT: FLG_ADDREG_DELVAL HEX: 00000004
+CONSTANT: FLG_ADDREG_APPEND HEX: 00000008
+CONSTANT: FLG_ADDREG_KEYONLY HEX: 00000010
+CONSTANT: FLG_ADDREG_OVERWRITEONLY HEX: 00000020
+CONSTANT: FLG_ADDREG_64BITKEY HEX: 00001000
+CONSTANT: FLG_ADDREG_KEYONLY_COMMON HEX: 00002000
+CONSTANT: FLG_ADDREG_32BITKEY HEX: 00004000
+CONSTANT: FLG_ADDREG_TYPE_MASK HEX: FFFF0001
+CONSTANT: FLG_ADDREG_TYPE_SZ HEX: 00000000
+CONSTANT: FLG_ADDREG_TYPE_MULTI_SZ HEX: 00010000
+CONSTANT: FLG_ADDREG_TYPE_EXPAND_SZ HEX: 00020000
+CONSTANT: FLG_ADDREG_TYPE_BINARY HEX: 00000001
+CONSTANT: FLG_ADDREG_TYPE_DWORD HEX: 00010001
+CONSTANT: FLG_ADDREG_TYPE_NONE HEX: 00020001
+CONSTANT: FLG_DELREG_VALUE HEX: 00000000
+CONSTANT: FLG_DELREG_TYPE_MASK $ FLG_ADDREG_TYPE_MASK
+CONSTANT: FLG_DELREG_TYPE_SZ $ FLG_ADDREG_TYPE_SZ
+CONSTANT: FLG_DELREG_TYPE_MULTI_SZ $ FLG_ADDREG_TYPE_MULTI_SZ
+CONSTANT: FLG_DELREG_TYPE_EXPAND_SZ $ FLG_ADDREG_TYPE_EXPAND_SZ
+CONSTANT: FLG_DELREG_TYPE_BINARY $ FLG_ADDREG_TYPE_BINARY
+CONSTANT: FLG_DELREG_TYPE_DWORD $ FLG_ADDREG_TYPE_DWORD
+CONSTANT: FLG_DELREG_TYPE_NONE $ FLG_ADDREG_TYPE_NONE
+CONSTANT: FLG_DELREG_64BITKEY $ FLG_ADDREG_64BITKEY
+CONSTANT: FLG_DELREG_KEYONLY_COMMON $ FLG_ADDREG_KEYONLY_COMMON
+CONSTANT: FLG_DELREG_32BITKEY $ FLG_ADDREG_32BITKEY
+CONSTANT: FLG_DELREG_OPERATION_MASK HEX: 000000FE
+CONSTANT: FLG_DELREG_MULTI_SZ_DELSTRING HEX: 00018002
+CONSTANT: FLG_BITREG_CLEARBITS HEX: 00000000
+CONSTANT: FLG_BITREG_SETBITS HEX: 00000001
+CONSTANT: FLG_BITREG_64BITKEY HEX: 00001000
+CONSTANT: FLG_BITREG_32BITKEY HEX: 00004000
+CONSTANT: FLG_INI2REG_64BITKEY HEX: 00001000
+CONSTANT: FLG_INI2REG_32BITKEY HEX: 00004000
+CONSTANT: FLG_REGSVR_DLLREGISTER HEX: 00000001
+CONSTANT: FLG_REGSVR_DLLINSTALL HEX: 00000002
+CONSTANT: FLG_PROFITEM_CURRENTUSER HEX: 00000001
+CONSTANT: FLG_PROFITEM_DELETE HEX: 00000002
+CONSTANT: FLG_PROFITEM_GROUP HEX: 00000004
+CONSTANT: FLG_PROFITEM_CSIDL HEX: 00000008
+CONSTANT: FLG_ADDPROPERTY_NOCLOBBER HEX: 00000001
+CONSTANT: FLG_ADDPROPERTY_OVERWRITEONLY HEX: 00000002
+CONSTANT: FLG_ADDPROPERTY_APPEND HEX: 00000004
+CONSTANT: FLG_ADDPROPERTY_OR HEX: 00000008
+CONSTANT: FLG_ADDPROPERTY_AND HEX: 00000010
+CONSTANT: FLG_DELPROPERTY_MULTI_SZ_DELSTRING HEX: 00000001
+
+FUNCTION: BOOL SetupInstallFromInfSectionA ( HWND Owner, HINF InfHandle, PCSTR SectionName, UINT Flags, HKEY RelativeKeyRoot, PCSTR SourceRootPath, UINT CopyFlags, PSP_FILE_CALLBACK_A MsgHandler, PVOID Context, HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData ) ;
+FUNCTION: BOOL SetupInstallFromInfSectionW ( HWND Owner, HINF InfHandle, PCWSTR SectionName, UINT Flags, HKEY RelativeKeyRoot, PCWSTR SourceRootPath, UINT CopyFlags, PSP_FILE_CALLBACK_W MsgHandler, PVOID Context, HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData ) ;
+ALIAS: SetupInstallFromInfSection SetupInstallFromInfSectionW
+
+CONSTANT: SPINST_LOGCONFIG HEX: 00000001
+CONSTANT: SPINST_INIFILES HEX: 00000002
+CONSTANT: SPINST_REGISTRY HEX: 00000004
+CONSTANT: SPINST_INI2REG HEX: 00000008
+CONSTANT: SPINST_FILES HEX: 00000010
+CONSTANT: SPINST_BITREG HEX: 00000020
+CONSTANT: SPINST_REGSVR HEX: 00000040
+CONSTANT: SPINST_UNREGSVR HEX: 00000080
+CONSTANT: SPINST_PROFILEITEMS HEX: 00000100
+CONSTANT: SPINST_COPYINF HEX: 00000200
+CONSTANT: SPINST_PROPERTIES HEX: 00000400
+CONSTANT: SPINST_ALL HEX: 000007ff
+CONSTANT: SPINST_SINGLESECTION HEX: 00010000
+CONSTANT: SPINST_LOGCONFIG_IS_FORCED HEX: 00020000
+CONSTANT: SPINST_LOGCONFIGS_ARE_OVERRIDES HEX: 00040000
+CONSTANT: SPINST_REGISTERCALLBACKAWARE HEX: 00080000
+CONSTANT: SPINST_DEVICEINSTALL HEX: 00100000
+
+FUNCTION: BOOL SetupInstallFilesFromInfSectionA ( HINF InfHandle, HINF LayoutInfHandle, HSPFILEQ FileQueue, PCSTR SectionName, PCSTR SourceRootPath, UINT CopyFlags ) ;
+FUNCTION: BOOL SetupInstallFilesFromInfSectionW ( HINF InfHandle, HINF LayoutInfHandle, HSPFILEQ FileQueue, PCWSTR SectionName, PCWSTR SourceRootPath, UINT CopyFlags ) ;
+ALIAS: SetupInstallFilesFromInfSection SetupInstallFilesFromInfSectionW
+
+CONSTANT: SPSVCINST_TAGTOFRONT HEX: 00000001
+CONSTANT: SPSVCINST_ASSOCSERVICE HEX: 00000002
+CONSTANT: SPSVCINST_DELETEEVENTLOGENTRY HEX: 00000004
+CONSTANT: SPSVCINST_NOCLOBBER_DISPLAYNAME HEX: 00000008
+CONSTANT: SPSVCINST_NOCLOBBER_STARTTYPE HEX: 00000010
+CONSTANT: SPSVCINST_NOCLOBBER_ERRORCONTROL HEX: 00000020
+CONSTANT: SPSVCINST_NOCLOBBER_LOADORDERGROUP HEX: 00000040
+CONSTANT: SPSVCINST_NOCLOBBER_DEPENDENCIES HEX: 00000080
+CONSTANT: SPSVCINST_NOCLOBBER_DESCRIPTION HEX: 00000100
+CONSTANT: SPSVCINST_STOPSERVICE HEX: 00000200
+CONSTANT: SPSVCINST_CLOBBER_SECURITY HEX: 00000400
+CONSTANT: SPSVCINST_STARTSERVICE HEX: 00000800
+CONSTANT: SPSVCINST_NOCLOBBER_REQUIREDPRIVILEGES HEX: 00001000
+
+FUNCTION: BOOL SetupInstallServicesFromInfSectionA ( HINF InfHandle, PCSTR SectionName, DWORD Flags ) ;
+FUNCTION: BOOL SetupInstallServicesFromInfSectionW ( HINF InfHandle, PCWSTR SectionName, DWORD Flags ) ;
+ALIAS: SetupInstallServicesFromInfSection SetupInstallServicesFromInfSectionW
+
+FUNCTION: BOOL SetupInstallServicesFromInfSectionExA ( HINF InfHandle, PCSTR SectionName, DWORD Flags, HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PVOID Reserved1, PVOID Reserved2 ) ;
+FUNCTION: BOOL SetupInstallServicesFromInfSectionExW ( HINF InfHandle, PCWSTR SectionName, DWORD Flags, HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PVOID Reserved1, PVOID Reserved2 ) ;
+ALIAS: SetupInstallServicesFromInfSectionEx SetupInstallServicesFromInfSectionExW
+
+FUNCTION: void InstallHinfSectionA ( HWND Window, HINSTANCE ModuleHandle, PCSTR CommandLine, INT ShowCommand ) ;
+FUNCTION: void InstallHinfSectionW ( HWND Window, HINSTANCE ModuleHandle, PCWSTR CommandLine, INT ShowCommand ) ;
+ALIAS: InstallHinfSection InstallHinfSectionW
+
+TYPEDEF: PVOID HSPFILELOG
+
+FUNCTION: HSPFILELOG SetupInitializeFileLogA ( PCSTR LogFileName, DWORD Flags ) ;
+FUNCTION: HSPFILELOG SetupInitializeFileLogW ( PCWSTR LogFileName, DWORD Flags ) ;
+ALIAS: SetupInitializeFileLog SetupInitializeFileLogW
+
+CONSTANT: SPFILELOG_SYSTEMLOG HEX: 00000001
+CONSTANT: SPFILELOG_FORCENEW HEX: 00000002
+CONSTANT: SPFILELOG_QUERYONLY HEX: 00000004
+
+FUNCTION: BOOL SetupTerminateFileLog ( HSPFILELOG FileLogHandle ) ;
+FUNCTION: BOOL SetupLogFileA ( HSPFILELOG FileLogHandle, PCSTR LogSectionName, PCSTR SourceFilename, PCSTR TargetFilename, DWORD Checksum, PCSTR DiskTagfile, PCSTR DiskDescription, PCSTR OtherInfo, DWORD Flags ) ;
+FUNCTION: BOOL SetupLogFileW ( HSPFILELOG FileLogHandle, PCWSTR LogSectionName, PCWSTR SourceFilename, PCWSTR TargetFilename, DWORD Checksum, PCWSTR DiskTagfile, PCWSTR DiskDescription, PCWSTR OtherInfo, DWORD Flags ) ;
+ALIAS: SetupLogFile SetupLogFileW
+
+CONSTANT: SPFILELOG_OEMFILE HEX: 00000001
+FUNCTION: BOOL SetupRemoveFileLogEntryA ( HSPFILELOG FileLogHandle, PCSTR LogSectionName, PCSTR TargetFilename ) ;
+FUNCTION: BOOL SetupRemoveFileLogEntryW ( HSPFILELOG FileLogHandle, PCWSTR LogSectionName, PCWSTR TargetFilename ) ;
+ALIAS: SetupRemoveFileLogEntry SetupRemoveFileLogEntryW
+
+C-ENUM:
+ SetupFileLogSourceFilename
+ SetupFileLogChecksum
+ SetupFileLogDiskTagfile
+ SetupFileLogDiskDescription
+ SetupFileLogOtherInfo
+ SetupFileLogMax ;
+TYPEDEF: int SetupFileLogInfo
+
+FUNCTION: BOOL SetupQueryFileLogA ( HSPFILELOG FileLogHandle, PCSTR LogSectionName, PCSTR TargetFilename, SetupFileLogInfo DesiredInfo, PSTR DataOut, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupQueryFileLogW ( HSPFILELOG FileLogHandle, PCWSTR LogSectionName, PCWSTR TargetFilename, SetupFileLogInfo DesiredInfo, PWSTR DataOut, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
+ALIAS: SetupQueryFileLog SetupQueryFileLogW
+
+TYPEDEF: DWORD LogSeverity
+CONSTANT: LogSevInformation HEX: 00000000
+CONSTANT: LogSevWarning HEX: 00000001
+CONSTANT: LogSevError HEX: 00000002
+CONSTANT: LogSevFatalError HEX: 00000003
+CONSTANT: LogSevMaximum HEX: 00000004
+
+FUNCTION: BOOL SetupOpenLog ( BOOL Erase ) ;
+FUNCTION: BOOL SetupLogErrorA ( LPCSTR MessageString, LogSeverity Severity ) ;
+FUNCTION: BOOL SetupLogErrorW ( LPCWSTR MessageString, LogSeverity Severity ) ;
+ALIAS: SetupLogError SetupLogErrorW
+
+FUNCTION: void SetupCloseLog ( ) ;
+FUNCTION: SP_LOG_TOKEN SetupGetThreadLogToken ( ) ;
+FUNCTION: void SetupSetThreadLogToken ( SP_LOG_TOKEN LogToken ) ;
+! Unavailable until FFI to vargargs is supported.
+! FUNCTION: void SetupWriteTextLog ( SP_LOG_TOKEN LogToken, DWORD Category, DWORD Flags, PCSTR MessageStr, ... ) ;
+! FUNCTION: void SetupWriteTextLogError ( SP_LOG_TOKEN LogToken, DWORD Category, DWORD LogFlags, DWORD Error, PCSTR MessageStr, ... ) ;
+FUNCTION: void SetupWriteTextLogInfLine ( SP_LOG_TOKEN LogToken, DWORD Flags, HINF InfHandle, PINFCONTEXT Context ) ;
+
+FUNCTION: BOOL SetupGetBackupInformationA ( HSPFILEQ QueueHandle, PSP_BACKUP_QUEUE_PARAMS_A BackupParams ) ;
+FUNCTION: BOOL SetupGetBackupInformationW ( HSPFILEQ QueueHandle, PSP_BACKUP_QUEUE_PARAMS_W BackupParams ) ;
+ALIAS: SetupGetBackupInformation SetupGetBackupInformationW
+
+FUNCTION: BOOL SetupPrepareQueueForRestoreA ( HSPFILEQ QueueHandle, PCSTR BackupPath, DWORD RestoreFlags ) ;
+FUNCTION: BOOL SetupPrepareQueueForRestoreW ( HSPFILEQ QueueHandle, PCWSTR BackupPath, DWORD RestoreFlags ) ;
+ALIAS: SetupPrepareQueueForRestore SetupPrepareQueueForRestoreW
+
+FUNCTION: BOOL SetupSetNonInteractiveMode ( BOOL NonInteractiveFlag ) ;
+FUNCTION: BOOL SetupGetNonInteractiveMode ( ) ;
+
+FUNCTION: HDEVINFO SetupDiCreateDeviceInfoList ( GUID* ClassGuid, HWND hwndParent ) ;
+FUNCTION: HDEVINFO SetupDiCreateDeviceInfoListExA ( GUID* ClassGuid, HWND hwndParent, PCSTR MachineName, PVOID Reserved ) ;
+FUNCTION: HDEVINFO SetupDiCreateDeviceInfoListExW ( GUID* ClassGuid, HWND hwndParent, PCWSTR MachineName, PVOID Reserved ) ;
+
+ALIAS: SetupDiCreateDeviceInfoListEx SetupDiCreateDeviceInfoListExW
+
+FUNCTION: BOOL SetupDiGetDeviceInfoListClass( HDEVINFO DeviceInfoSet, LPGUID ClassGuid ) ;
+FUNCTION: BOOL SetupDiGetDeviceInfoListDetailA ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_LIST_DETAIL_DATA_A DeviceInfoSetDetailData ) ;
+FUNCTION: BOOL SetupDiGetDeviceInfoListDetailW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_LIST_DETAIL_DATA_W DeviceInfoSetDetailData ) ;
+ALIAS: SetupDiGetDeviceInfoListDetail SetupDiGetDeviceInfoListDetailW
+
+CONSTANT: DICD_GENERATE_ID HEX: 00000001
+CONSTANT: DICD_INHERIT_CLASSDRVS HEX: 00000002
+
+FUNCTION: BOOL SetupDiCreateDeviceInfoA ( HDEVINFO DeviceInfoSet, PCSTR DeviceName, GUID* ClassGuid, PCSTR DeviceDescription, HWND hwndParent, DWORD CreationFlags, PSP_DEVINFO_DATA DeviceInfoData ) ;
+FUNCTION: BOOL SetupDiCreateDeviceInfoW ( HDEVINFO DeviceInfoSet, PCWSTR DeviceName, GUID* ClassGuid, PCWSTR DeviceDescription, HWND hwndParent, DWORD CreationFlags, PSP_DEVINFO_DATA DeviceInfoData ) ;
+ALIAS: SetupDiCreateDeviceInfo SetupDiCreateDeviceInfoW
+
+CONSTANT: DIOD_INHERIT_CLASSDRVS HEX: 00000002
+CONSTANT: DIOD_CANCEL_REMOVE HEX: 00000004
+
+FUNCTION: BOOL SetupDiOpenDeviceInfoA ( HDEVINFO DeviceInfoSet, PCSTR DeviceInstanceId, HWND hwndParent, DWORD OpenFlags, PSP_DEVINFO_DATA DeviceInfoData ) ;
+FUNCTION: BOOL SetupDiOpenDeviceInfoW ( HDEVINFO DeviceInfoSet, PCWSTR DeviceInstanceId, HWND hwndParent, DWORD OpenFlags, PSP_DEVINFO_DATA DeviceInfoData ) ;
+ALIAS: SetupDiOpenDeviceInfo SetupDiOpenDeviceInfoW
+
+FUNCTION: BOOL SetupDiGetDeviceInstanceIdA ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSTR DeviceInstanceId, DWORD DeviceInstanceIdSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupDiGetDeviceInstanceIdW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PWSTR DeviceInstanceId, DWORD DeviceInstanceIdSize, PDWORD RequiredSize ) ;
+ALIAS: SetupDiGetDeviceInstanceId SetupDiGetDeviceInstanceIdW
+
+FUNCTION: BOOL SetupDiDeleteDeviceInfo ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData ) ;
+FUNCTION: BOOL SetupDiEnumDeviceInfo ( HDEVINFO DeviceInfoSet, DWORD MemberIndex, PSP_DEVINFO_DATA DeviceInfoData ) ;
+FUNCTION: BOOL SetupDiDestroyDeviceInfoList ( HDEVINFO DeviceInfoSet ) ;
+FUNCTION: BOOL SetupDiEnumDeviceInterfaces ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, GUID* InterfaceClassGuid, DWORD MemberIndex, PSP_DEVICE_INTERFACE_DATA DeviceInterfaceData ) ;
+ALIAS: SetupDiEnumInterfaceDevice SetupDiEnumDeviceInterfaces
+
+FUNCTION: BOOL SetupDiCreateDeviceInterfaceA ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, GUID* InterfaceClassGuid, PCSTR ReferenceString, DWORD CreationFlags, PSP_DEVICE_INTERFACE_DATA DeviceInterfaceData ) ;
+FUNCTION: BOOL SetupDiCreateDeviceInterfaceW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, GUID* InterfaceClassGuid, PCWSTR ReferenceString, DWORD CreationFlags, PSP_DEVICE_INTERFACE_DATA DeviceInterfaceData ) ;
+ALIAS: SetupDiCreateDeviceInterface SetupDiCreateDeviceInterfaceW
+
+ALIAS: SetupDiCreateInterfaceDeviceW SetupDiCreateDeviceInterfaceW
+ALIAS: SetupDiCreateInterfaceDeviceA SetupDiCreateDeviceInterfaceA
+
+ALIAS: SetupDiCreateInterfaceDevice SetupDiCreateDeviceInterfaceW
+
+CONSTANT: DIODI_NO_ADD HEX: 00000001
+
+FUNCTION: BOOL SetupDiOpenDeviceInterfaceA ( HDEVINFO DeviceInfoSet, PCSTR DevicePath, DWORD OpenFlags, PSP_DEVICE_INTERFACE_DATA DeviceInterfaceData ) ;
+FUNCTION: BOOL SetupDiOpenDeviceInterfaceW ( HDEVINFO DeviceInfoSet, PCWSTR DevicePath, DWORD OpenFlags, PSP_DEVICE_INTERFACE_DATA DeviceInterfaceData ) ;
+ALIAS: SetupDiOpenDeviceInterface SetupDiOpenDeviceInterfaceW
+
+ALIAS: SetupDiOpenInterfaceDeviceW SetupDiOpenDeviceInterfaceW
+ALIAS: SetupDiOpenInterfaceDeviceA SetupDiOpenDeviceInterfaceA
+
+ALIAS: SetupDiOpenInterfaceDevice SetupDiOpenDeviceInterfaceW
+
+FUNCTION: BOOL SetupDiGetDeviceInterfaceAlias ( HDEVINFO DeviceInfoSet, PSP_DEVICE_INTERFACE_DATA DeviceInterfaceData, GUID* AliasInterfaceClassGuid, PSP_DEVICE_INTERFACE_DATA AliasDeviceInterfaceData ) ;
+ALIAS: SetupDiGetInterfaceDeviceAlias SetupDiGetDeviceInterfaceAlias
+
+FUNCTION: BOOL SetupDiDeleteDeviceInterfaceData ( HDEVINFO DeviceInfoSet, PSP_DEVICE_INTERFACE_DATA DeviceInterfaceData ) ;
+ALIAS: SetupDiDeleteInterfaceDeviceData SetupDiDeleteDeviceInterfaceData
+
+FUNCTION: BOOL SetupDiRemoveDeviceInterface ( HDEVINFO DeviceInfoSet, PSP_DEVICE_INTERFACE_DATA DeviceInterfaceData ) ;
+ALIAS: SetupDiRemoveInterfaceDevice SetupDiRemoveDeviceInterface
+
+FUNCTION: BOOL SetupDiGetDeviceInterfaceDetailA ( HDEVINFO DeviceInfoSet, PSP_DEVICE_INTERFACE_DATA DeviceInterfaceData, PSP_DEVICE_INTERFACE_DETAIL_DATA_A DeviceInterfaceDetailData, DWORD DeviceInterfaceDetailDataSize, PDWORD RequiredSize, PSP_DEVINFO_DATA DeviceInfoData ) ;
+FUNCTION: BOOL SetupDiGetDeviceInterfaceDetailW ( HDEVINFO DeviceInfoSet, PSP_DEVICE_INTERFACE_DATA DeviceInterfaceData, PSP_DEVICE_INTERFACE_DETAIL_DATA_W DeviceInterfaceDetailData, DWORD DeviceInterfaceDetailDataSize, PDWORD RequiredSize, PSP_DEVINFO_DATA DeviceInfoData ) ;
+ALIAS: SetupDiGetDeviceInterfaceDetail SetupDiGetDeviceInterfaceDetailW
+
+ALIAS: SetupDiGetInterfaceDeviceDetailW SetupDiGetDeviceInterfaceDetailW
+ALIAS: SetupDiGetInterfaceDeviceDetailA SetupDiGetDeviceInterfaceDetailA
+
+ALIAS: SetupDiGetInterfaceDeviceDetail SetupDiGetDeviceInterfaceDetailW
+
+FUNCTION: BOOL SetupDiInstallDeviceInterfaces ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData ) ;
+ALIAS: SetupDiInstallInterfaceDevices SetupDiInstallDeviceInterfaces
+
+FUNCTION: BOOL SetupDiSetDeviceInterfaceDefault ( HDEVINFO DeviceInfoSet, PSP_DEVICE_INTERFACE_DATA DeviceInterfaceData, DWORD Flags, PVOID Reserved ) ;
+
+CONSTANT: SPRDI_FIND_DUPS HEX: 00000001
+
+FUNCTION: BOOL SetupDiRegisterDeviceInfo ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, DWORD Flags, PSP_DETSIG_CMPPROC CompareProc, PVOID CompareContext, PSP_DEVINFO_DATA DupDeviceInfoData ) ;
+
+CONSTANT: SPDIT_NODRIVER HEX: 00000000
+CONSTANT: SPDIT_CLASSDRIVER HEX: 00000001
+CONSTANT: SPDIT_COMPATDRIVER HEX: 00000002
+
+FUNCTION: BOOL SetupDiBuildDriverInfoList ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, DWORD DriverType ) ;
+FUNCTION: BOOL SetupDiCancelDriverInfoSearch ( HDEVINFO DeviceInfoSet ) ;
+FUNCTION: BOOL SetupDiEnumDriverInfoA ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, DWORD DriverType, DWORD MemberIndex, PSP_DRVINFO_DATA_A DriverInfoData ) ;
+FUNCTION: BOOL SetupDiEnumDriverInfoW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, DWORD DriverType, DWORD MemberIndex, PSP_DRVINFO_DATA_W DriverInfoData ) ;
+ALIAS: SetupDiEnumDriverInfo SetupDiEnumDriverInfoW
+
+FUNCTION: BOOL SetupDiGetSelectedDriverA ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSP_DRVINFO_DATA_A DriverInfoData ) ;
+FUNCTION: BOOL SetupDiGetSelectedDriverW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSP_DRVINFO_DATA_W DriverInfoData ) ;
+ALIAS: SetupDiGetSelectedDriver SetupDiGetSelectedDriverW
+
+FUNCTION: BOOL SetupDiSetSelectedDriverA ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSP_DRVINFO_DATA_A DriverInfoData ) ;
+FUNCTION: BOOL SetupDiSetSelectedDriverW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSP_DRVINFO_DATA_W DriverInfoData ) ;
+ALIAS: SetupDiSetSelectedDriver SetupDiSetSelectedDriverW
+
+FUNCTION: BOOL SetupDiGetDriverInfoDetailA ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSP_DRVINFO_DATA_A DriverInfoData, PSP_DRVINFO_DETAIL_DATA_A DriverInfoDetailData, DWORD DriverInfoDetailDataSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupDiGetDriverInfoDetailW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSP_DRVINFO_DATA_W DriverInfoData, PSP_DRVINFO_DETAIL_DATA_W DriverInfoDetailData, DWORD DriverInfoDetailDataSize, PDWORD RequiredSize ) ;
+ALIAS: SetupDiGetDriverInfoDetail SetupDiGetDriverInfoDetailW
+
+FUNCTION: BOOL SetupDiDestroyDriverInfoList ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, DWORD DriverType ) ;
+
+CONSTANT: DIGCF_DEFAULT HEX: 00000001
+CONSTANT: DIGCF_PRESENT HEX: 00000002
+CONSTANT: DIGCF_ALLCLASSES HEX: 00000004
+CONSTANT: DIGCF_PROFILE HEX: 00000008
+CONSTANT: DIGCF_DEVICEINTERFACE HEX: 00000010
+CONSTANT: DIGCF_INTERFACEDEVICE $ DIGCF_DEVICEINTERFACE
+
+FUNCTION: HDEVINFO SetupDiGetClassDevsA ( GUID* ClassGuid, PCSTR Enumerator, HWND hwndParent, DWORD Flags ) ;
+FUNCTION: HDEVINFO SetupDiGetClassDevsW ( GUID* ClassGuid, PCWSTR Enumerator, HWND hwndParent, DWORD Flags ) ;
+ALIAS: SetupDiGetClassDevs SetupDiGetClassDevsW
+
+FUNCTION: HDEVINFO SetupDiGetClassDevsExA ( GUID* ClassGuid, PCSTR Enumerator, HWND hwndParent, DWORD Flags, HDEVINFO DeviceInfoSet, PCSTR MachineName, PVOID Reserved ) ;
+FUNCTION: HDEVINFO SetupDiGetClassDevsExW ( GUID* ClassGuid, PCWSTR Enumerator, HWND hwndParent, DWORD Flags, HDEVINFO DeviceInfoSet, PCWSTR MachineName, PVOID Reserved ) ;
+ALIAS: SetupDiGetClassDevsEx SetupDiGetClassDevsExW
+
+FUNCTION: BOOL SetupDiGetINFClassA ( PCSTR InfName, LPGUID ClassGuid, PSTR ClassName, DWORD ClassNameSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupDiGetINFClassW ( PCWSTR InfName, LPGUID ClassGuid, PWSTR ClassName, DWORD ClassNameSize, PDWORD RequiredSize ) ;
+ALIAS: SetupDiGetINFClass SetupDiGetINFClassW
+
+CONSTANT: DIBCI_NOINSTALLCLASS HEX: 00000001
+CONSTANT: DIBCI_NODISPLAYCLASS HEX: 00000002
+
+FUNCTION: BOOL SetupDiBuildClassInfoList ( DWORD Flags, LPGUID ClassGuidList, DWORD ClassGuidListSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupDiBuildClassInfoListExA ( DWORD Flags, LPGUID ClassGuidList, DWORD ClassGuidListSize, PDWORD RequiredSize, PCSTR MachineName, PVOID Reserved ) ;
+FUNCTION: BOOL SetupDiBuildClassInfoListExW ( DWORD Flags, LPGUID ClassGuidList, DWORD ClassGuidListSize, PDWORD RequiredSize, PCWSTR MachineName, PVOID Reserved ) ;
+ALIAS: SetupDiBuildClassInfoListEx SetupDiBuildClassInfoListExW
+
+FUNCTION: BOOL SetupDiGetClassDescriptionA ( GUID* ClassGuid, PSTR ClassDescription, DWORD ClassDescriptionSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupDiGetClassDescriptionW ( GUID* ClassGuid, PWSTR ClassDescription, DWORD ClassDescriptionSize, PDWORD RequiredSize ) ;
+ALIAS: SetupDiGetClassDescription SetupDiGetClassDescriptionW
+
+FUNCTION: BOOL SetupDiGetClassDescriptionExA ( GUID* ClassGuid, PSTR ClassDescription, DWORD ClassDescriptionSize, PDWORD RequiredSize, PCSTR MachineName, PVOID Reserved ) ;
+FUNCTION: BOOL SetupDiGetClassDescriptionExW ( GUID* ClassGuid, PWSTR ClassDescription, DWORD ClassDescriptionSize, PDWORD RequiredSize, PCWSTR MachineName, PVOID Reserved ) ;
+ALIAS: SetupDiGetClassDescriptionEx SetupDiGetClassDescriptionExW
+
+FUNCTION: BOOL SetupDiCallClassInstaller ( DI_FUNCTION InstallFunction, HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData ) ;
+FUNCTION: BOOL SetupDiSelectDevice ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData ) ;
+FUNCTION: BOOL SetupDiSelectBestCompatDrv ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData ) ;
+FUNCTION: BOOL SetupDiInstallDevice ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData ) ;
+FUNCTION: BOOL SetupDiInstallDriverFiles ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData ) ;
+FUNCTION: BOOL SetupDiRegisterCoDeviceInstallers( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData ) ;
+FUNCTION: BOOL SetupDiRemoveDevice ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData ) ;
+FUNCTION: BOOL SetupDiUnremoveDevice ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData ) ;
+FUNCTION: BOOL SetupDiRestartDevices ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData ) ;
+FUNCTION: BOOL SetupDiChangeState ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData ) ;
+FUNCTION: BOOL SetupDiFinishInstallAction ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData ) ;
+
+FUNCTION: BOOL SetupDiInstallClassA ( HWND hwndParent, PCSTR InfFileName, DWORD Flags, HSPFILEQ FileQueue ) ;
+FUNCTION: BOOL SetupDiInstallClassW ( HWND hwndParent, PCWSTR InfFileName, DWORD Flags, HSPFILEQ FileQueue ) ;
+ALIAS: SetupDiInstallClass SetupDiInstallClassW
+
+FUNCTION: BOOL SetupDiInstallClassExA ( HWND hwndParent, PCSTR InfFileName, DWORD Flags, HSPFILEQ FileQueue, GUID* InterfaceClassGuid, PVOID Reserved1, PVOID Reserved2 ) ;
+FUNCTION: BOOL SetupDiInstallClassExW ( HWND hwndParent, PCWSTR InfFileName, DWORD Flags, HSPFILEQ FileQueue, GUID* InterfaceClassGuid, PVOID Reserved1, PVOID Reserved2 ) ;
+ALIAS: SetupDiInstallClassEx SetupDiInstallClassExW
+
+FUNCTION: HKEY SetupDiOpenClassRegKey ( GUID* ClassGuid, REGSAM samDesired ) ;
+
+CONSTANT: DIOCR_INSTALLER HEX: 00000001
+CONSTANT: DIOCR_INTERFACE HEX: 00000002
+
+FUNCTION: HKEY SetupDiOpenClassRegKeyExA ( GUID* ClassGuid, REGSAM samDesired, DWORD Flags, PCSTR MachineName, PVOID Reserved ) ;
+FUNCTION: HKEY SetupDiOpenClassRegKeyExW ( GUID* ClassGuid, REGSAM samDesired, DWORD Flags, PCWSTR MachineName, PVOID Reserved ) ;
+ALIAS: SetupDiOpenClassRegKeyEx SetupDiOpenClassRegKeyExW
+
+FUNCTION: HKEY SetupDiCreateDeviceInterfaceRegKeyA ( HDEVINFO DeviceInfoSet, PSP_DEVICE_INTERFACE_DATA DeviceInterfaceData, DWORD Reserved, REGSAM samDesired, HINF InfHandle, PCSTR InfSectionName ) ;
+FUNCTION: HKEY SetupDiCreateDeviceInterfaceRegKeyW ( HDEVINFO DeviceInfoSet, PSP_DEVICE_INTERFACE_DATA DeviceInterfaceData, DWORD Reserved, REGSAM samDesired, HINF InfHandle, PCWSTR InfSectionName ) ;
+ALIAS: SetupDiCreateDeviceInterfaceRegKey SetupDiCreateDeviceInterfaceRegKeyW
+ALIAS: SetupDiCreateInterfaceDeviceRegKeyW SetupDiCreateDeviceInterfaceRegKeyW
+ALIAS: SetupDiCreateInterfaceDeviceRegKeyA SetupDiCreateDeviceInterfaceRegKeyA
+ALIAS: SetupDiCreateInterfaceDeviceRegKey SetupDiCreateDeviceInterfaceRegKeyW
+
+FUNCTION: HKEY SetupDiOpenDeviceInterfaceRegKey ( HDEVINFO DeviceInfoSet, PSP_DEVICE_INTERFACE_DATA DeviceInterfaceData, DWORD Reserved, REGSAM samDesired ) ;
+ALIAS: SetupDiOpenInterfaceDeviceRegKey SetupDiOpenDeviceInterfaceRegKey
+
+FUNCTION: BOOL SetupDiDeleteDeviceInterfaceRegKey ( HDEVINFO DeviceInfoSet, PSP_DEVICE_INTERFACE_DATA DeviceInterfaceData, DWORD Reserved ) ;
+ALIAS: SetupDiDeleteInterfaceDeviceRegKey SetupDiDeleteDeviceInterfaceRegKey
+
+CONSTANT: DIREG_DEV HEX: 00000001
+CONSTANT: DIREG_DRV HEX: 00000002
+CONSTANT: DIREG_BOTH HEX: 00000004
+
+FUNCTION: HKEY SetupDiCreateDevRegKeyA ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, DWORD Scope, DWORD HwProfile, DWORD KeyType, HINF InfHandle, PCSTR InfSectionName ) ;
+FUNCTION: HKEY SetupDiCreateDevRegKeyW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, DWORD Scope, DWORD HwProfile, DWORD KeyType, HINF InfHandle, PCWSTR InfSectionName ) ;
+ALIAS: SetupDiCreateDevRegKey SetupDiCreateDevRegKeyW
+
+FUNCTION: HKEY SetupDiOpenDevRegKey ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, DWORD Scope, DWORD HwProfile, DWORD KeyType, REGSAM samDesired ) ;
+FUNCTION: BOOL SetupDiDeleteDevRegKey ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, DWORD Scope, DWORD HwProfile, DWORD KeyType ) ;
+FUNCTION: BOOL SetupDiGetHwProfileList ( PDWORD HwProfileList, DWORD HwProfileListSize, PDWORD RequiredSize, PDWORD CurrentlyActiveIndex ) ;
+FUNCTION: BOOL SetupDiGetHwProfileListExA ( PDWORD HwProfileList, DWORD HwProfileListSize, PDWORD RequiredSize, PDWORD CurrentlyActiveIndex, PCSTR MachineName, PVOID Reserved ) ;
+FUNCTION: BOOL SetupDiGetHwProfileListExW ( PDWORD HwProfileList, DWORD HwProfileListSize, PDWORD RequiredSize, PDWORD CurrentlyActiveIndex, PCWSTR MachineName, PVOID Reserved ) ;
+ALIAS: SetupDiGetHwProfileListEx SetupDiGetHwProfileListExW
+
+FUNCTION: BOOL SetupDiGetDevicePropertyKeys ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, DEVPROPKEY* PropertyKeyArray, DWORD PropertyKeyCount, PDWORD RequiredPropertyKeyCount, DWORD Flags ) ;
+FUNCTION: BOOL SetupDiGetDevicePropertyW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, DEVPROPKEY* PropertyKey, DEVPROPTYPE* PropertyType, PBYTE PropertyBuffer, DWORD PropertyBufferSize, PDWORD RequiredSize, DWORD Flags ) ;
+ALIAS: SetupDiGetDeviceProperty SetupDiGetDevicePropertyW
+
+FUNCTION: BOOL SetupDiSetDevicePropertyW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, DEVPROPKEY* PropertyKey, DEVPROPTYPE PropertyType, PBYTE PropertyBuffer, DWORD PropertyBufferSize, DWORD Flags ) ;
+ALIAS: SetupDiSetDeviceProperty SetupDiSetDevicePropertyW
+
+FUNCTION: BOOL SetupDiGetDeviceInterfacePropertyKeys ( HDEVINFO DeviceInfoSet, PSP_DEVICE_INTERFACE_DATA DeviceInterfaceData, DEVPROPKEY* PropertyKeyArray, DWORD PropertyKeyCount, PDWORD RequiredPropertyKeyCount, DWORD Flags ) ;
+FUNCTION: BOOL SetupDiGetDeviceInterfacePropertyW ( HDEVINFO DeviceInfoSet, PSP_DEVICE_INTERFACE_DATA DeviceInterfaceData, DEVPROPKEY* PropertyKey, DEVPROPTYPE* PropertyType, PBYTE PropertyBuffer, DWORD PropertyBufferSize, PDWORD RequiredSize, DWORD Flags ) ;
+ALIAS: SetupDiGetDeviceInterfaceProperty SetupDiGetDeviceInterfacePropertyW
+
+FUNCTION: BOOL SetupDiSetDeviceInterfacePropertyW ( HDEVINFO DeviceInfoSet, PSP_DEVICE_INTERFACE_DATA DeviceInterfaceData, DEVPROPKEY* PropertyKey, DEVPROPTYPE PropertyType, PBYTE PropertyBuffer, DWORD PropertyBufferSize, DWORD Flags ) ;
+ALIAS: SetupDiSetDeviceInterfaceProperty SetupDiSetDeviceInterfacePropertyW
+
+CONSTANT: DICLASSPROP_INSTALLER HEX: 00000001
+CONSTANT: DICLASSPROP_INTERFACE HEX: 00000002
+
+FUNCTION: BOOL SetupDiGetClassPropertyKeys ( GUID* ClassGuid, DEVPROPKEY* PropertyKeyArray, DWORD PropertyKeyCount, PDWORD RequiredPropertyKeyCount, DWORD Flags ) ;
+FUNCTION: BOOL SetupDiGetClassPropertyKeysExW ( GUID* ClassGuid, DEVPROPKEY* PropertyKeyArray, DWORD PropertyKeyCount, PDWORD RequiredPropertyKeyCount, DWORD Flags, PCWSTR MachineName, PVOID Reserved ) ;
+ALIAS: SetupDiGetClassPropertyKeysEx SetupDiGetClassPropertyKeysExW
+
+FUNCTION: BOOL SetupDiGetClassPropertyW ( GUID* ClassGuid, DEVPROPKEY* PropertyKey, DEVPROPTYPE* PropertyType, PBYTE PropertyBuffer, DWORD PropertyBufferSize, PDWORD RequiredSize, DWORD Flags ) ;
+ALIAS: SetupDiGetClassProperty SetupDiGetClassPropertyW
+
+FUNCTION: BOOL SetupDiGetClassPropertyExW ( GUID* ClassGuid, DEVPROPKEY* PropertyKey, DEVPROPTYPE* PropertyType, PBYTE PropertyBuffer, DWORD PropertyBufferSize, PDWORD RequiredSize, DWORD Flags, PCWSTR MachineName, PVOID Reserved ) ;
+ALIAS: SetupDiGetClassPropertyEx SetupDiGetClassPropertyExW
+
+FUNCTION: BOOL SetupDiSetClassPropertyW ( GUID* ClassGuid, DEVPROPKEY* PropertyKey, DEVPROPTYPE PropertyType, PBYTE PropertyBuffer, DWORD PropertyBufferSize, DWORD Flags ) ;
+ALIAS: SetupDiSetClassProperty SetupDiSetClassPropertyW
+
+FUNCTION: BOOL SetupDiSetClassPropertyExW ( GUID* ClassGuid, DEVPROPKEY* PropertyKey, DEVPROPTYPE PropertyType, PBYTE PropertyBuffer, DWORD PropertyBufferSize, DWORD Flags, PCWSTR MachineName, PVOID Reserved ) ;
+ALIAS: SetupDiSetClassPropertyEx SetupDiSetClassPropertyExW
+
+CONSTANT: SPDRP_DEVICEDESC HEX: 00000000
+CONSTANT: SPDRP_HARDWAREID HEX: 00000001
+CONSTANT: SPDRP_COMPATIBLEIDS HEX: 00000002
+CONSTANT: SPDRP_UNUSED0 HEX: 00000003
+CONSTANT: SPDRP_SERVICE HEX: 00000004
+CONSTANT: SPDRP_UNUSED1 HEX: 00000005
+CONSTANT: SPDRP_UNUSED2 HEX: 00000006
+CONSTANT: SPDRP_CLASS HEX: 00000007
+CONSTANT: SPDRP_CLASSGUID HEX: 00000008
+CONSTANT: SPDRP_DRIVER HEX: 00000009
+CONSTANT: SPDRP_CONFIGFLAGS HEX: 0000000A
+CONSTANT: SPDRP_MFG HEX: 0000000B
+CONSTANT: SPDRP_FRIENDLYNAME HEX: 0000000C
+CONSTANT: SPDRP_LOCATION_INFORMATION HEX: 0000000D
+CONSTANT: SPDRP_PHYSICAL_DEVICE_OBJECT_NAME HEX: 0000000E
+CONSTANT: SPDRP_CAPABILITIES HEX: 0000000F
+CONSTANT: SPDRP_UI_NUMBER HEX: 00000010
+CONSTANT: SPDRP_UPPERFILTERS HEX: 00000011
+CONSTANT: SPDRP_LOWERFILTERS HEX: 00000012
+CONSTANT: SPDRP_BUSTYPEGUID HEX: 00000013
+CONSTANT: SPDRP_LEGACYBUSTYPE HEX: 00000014
+CONSTANT: SPDRP_BUSNUMBER HEX: 00000015
+CONSTANT: SPDRP_ENUMERATOR_NAME HEX: 00000016
+CONSTANT: SPDRP_SECURITY HEX: 00000017
+CONSTANT: SPDRP_SECURITY_SDS HEX: 00000018
+CONSTANT: SPDRP_DEVTYPE HEX: 00000019
+CONSTANT: SPDRP_EXCLUSIVE HEX: 0000001A
+CONSTANT: SPDRP_CHARACTERISTICS HEX: 0000001B
+CONSTANT: SPDRP_ADDRESS HEX: 0000001C
+CONSTANT: SPDRP_UI_NUMBER_DESC_FORMAT HEX: 0000001D
+CONSTANT: SPDRP_DEVICE_POWER_DATA HEX: 0000001E
+CONSTANT: SPDRP_REMOVAL_POLICY HEX: 0000001F
+CONSTANT: SPDRP_REMOVAL_POLICY_HW_DEFAULT HEX: 00000020
+CONSTANT: SPDRP_REMOVAL_POLICY_OVERRIDE HEX: 00000021
+CONSTANT: SPDRP_INSTALL_STATE HEX: 00000022
+CONSTANT: SPDRP_LOCATION_PATHS HEX: 00000023
+CONSTANT: SPDRP_BASE_CONTAINERID HEX: 00000024
+CONSTANT: SPDRP_MAXIMUM_PROPERTY HEX: 00000025
+CONSTANT: SPCRP_UPPERFILTERS HEX: 00000011
+CONSTANT: SPCRP_LOWERFILTERS HEX: 00000012
+CONSTANT: SPCRP_SECURITY HEX: 00000017
+CONSTANT: SPCRP_SECURITY_SDS HEX: 00000018
+CONSTANT: SPCRP_DEVTYPE HEX: 00000019
+CONSTANT: SPCRP_EXCLUSIVE HEX: 0000001A
+CONSTANT: SPCRP_CHARACTERISTICS HEX: 0000001B
+CONSTANT: SPCRP_MAXIMUM_PROPERTY HEX: 0000001C
+
+FUNCTION: BOOL SetupDiGetDeviceRegistryPropertyA ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, DWORD Property, PDWORD PropertyRegDataType, PBYTE PropertyBuffer, DWORD PropertyBufferSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupDiGetDeviceRegistryPropertyW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, DWORD Property, PDWORD PropertyRegDataType, PBYTE PropertyBuffer, DWORD PropertyBufferSize, PDWORD RequiredSize ) ;
+ALIAS: SetupDiGetDeviceRegistryProperty SetupDiGetDeviceRegistryPropertyW
+
+FUNCTION: BOOL SetupDiGetClassRegistryPropertyA ( GUID* ClassGuid, DWORD Property, PDWORD PropertyRegDataType, PBYTE PropertyBuffer, DWORD PropertyBufferSize, PDWORD RequiredSize, PCSTR MachineName, PVOID Reserved ) ;
+FUNCTION: BOOL SetupDiGetClassRegistryPropertyW ( GUID* ClassGuid, DWORD Property, PDWORD PropertyRegDataType, PBYTE PropertyBuffer, DWORD PropertyBufferSize, PDWORD RequiredSize, PCWSTR MachineName, PVOID Reserved ) ;
+ALIAS: SetupDiGetClassRegistryProperty SetupDiGetClassRegistryPropertyW
+
+FUNCTION: BOOL SetupDiSetDeviceRegistryPropertyA ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, DWORD Property, BYTE* PropertyBuffer, DWORD PropertyBufferSize ) ;
+FUNCTION: BOOL SetupDiSetDeviceRegistryPropertyW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, DWORD Property, BYTE* PropertyBuffer, DWORD PropertyBufferSize ) ;
+ALIAS: SetupDiSetDeviceRegistryProperty SetupDiSetDeviceRegistryPropertyW
+
+FUNCTION: BOOL SetupDiSetClassRegistryPropertyA ( GUID* ClassGuid, DWORD Property, BYTE* PropertyBuffer, DWORD PropertyBufferSize, PCSTR MachineName, PVOID Reserved ) ;
+FUNCTION: BOOL SetupDiSetClassRegistryPropertyW ( GUID* ClassGuid, DWORD Property, BYTE* PropertyBuffer, DWORD PropertyBufferSize, PCWSTR MachineName, PVOID Reserved ) ;
+ALIAS: SetupDiSetClassRegistryProperty SetupDiSetClassRegistryPropertyW
+
+FUNCTION: BOOL SetupDiGetDeviceInstallParamsA ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSP_DEVINSTALL_PARAMS_A DeviceInstallParams ) ;
+FUNCTION: BOOL SetupDiGetDeviceInstallParamsW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSP_DEVINSTALL_PARAMS_W DeviceInstallParams ) ;
+ALIAS: SetupDiGetDeviceInstallParams SetupDiGetDeviceInstallParamsW
+
+FUNCTION: BOOL SetupDiGetClassInstallParamsA ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSP_CLASSINSTALL_HEADER ClassInstallParams, DWORD ClassInstallParamsSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupDiGetClassInstallParamsW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSP_CLASSINSTALL_HEADER ClassInstallParams, DWORD ClassInstallParamsSize, PDWORD RequiredSize ) ;
+ALIAS: SetupDiGetClassInstallParams SetupDiGetClassInstallParamsW
+
+FUNCTION: BOOL SetupDiSetDeviceInstallParamsA ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSP_DEVINSTALL_PARAMS_A DeviceInstallParams ) ;
+FUNCTION: BOOL SetupDiSetDeviceInstallParamsW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSP_DEVINSTALL_PARAMS_W DeviceInstallParams ) ;
+ALIAS: SetupDiSetDeviceInstallParams SetupDiSetDeviceInstallParamsW
+
+FUNCTION: BOOL SetupDiSetClassInstallParamsA ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSP_CLASSINSTALL_HEADER ClassInstallParams, DWORD ClassInstallParamsSize ) ;
+FUNCTION: BOOL SetupDiSetClassInstallParamsW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSP_CLASSINSTALL_HEADER ClassInstallParams, DWORD ClassInstallParamsSize ) ;
+ALIAS: SetupDiSetClassInstallParams SetupDiSetClassInstallParamsW
+
+FUNCTION: BOOL SetupDiGetDriverInstallParamsA ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSP_DRVINFO_DATA_A DriverInfoData, PSP_DRVINSTALL_PARAMS DriverInstallParams ) ;
+FUNCTION: BOOL SetupDiGetDriverInstallParamsW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSP_DRVINFO_DATA_W DriverInfoData, PSP_DRVINSTALL_PARAMS DriverInstallParams ) ;
+ALIAS: SetupDiGetDriverInstallParams SetupDiGetDriverInstallParamsW
+
+FUNCTION: BOOL SetupDiSetDriverInstallParamsA ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSP_DRVINFO_DATA_A DriverInfoData, PSP_DRVINSTALL_PARAMS DriverInstallParams ) ;
+FUNCTION: BOOL SetupDiSetDriverInstallParamsW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSP_DRVINFO_DATA_W DriverInfoData, PSP_DRVINSTALL_PARAMS DriverInstallParams ) ;
+ALIAS: SetupDiSetDriverInstallParams SetupDiSetDriverInstallParamsW
+
+FUNCTION: BOOL SetupDiLoadClassIcon ( GUID* ClassGuid, HICON* LargeIcon, PINT MiniIconIndex ) ;
+FUNCTION: BOOL SetupDiLoadDeviceIcon ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, UINT cxIcon, UINT cyIcon, DWORD Flags, HICON* hIcon ) ;
+
+CONSTANT: DMI_MASK HEX: 00000001
+CONSTANT: DMI_BKCOLOR HEX: 00000002
+CONSTANT: DMI_USERECT HEX: 00000004
+
+FUNCTION: INT SetupDiDrawMiniIcon ( HDC hdc, RECT rc, INT MiniIconIndex, DWORD Flags ) ;
+FUNCTION: BOOL SetupDiGetClassBitmapIndex ( GUID* ClassGuid, PINT MiniIconIndex ) ;
+FUNCTION: BOOL SetupDiGetClassImageList ( PSP_CLASSIMAGELIST_DATA ClassImageListData ) ;
+FUNCTION: BOOL SetupDiGetClassImageListExA ( PSP_CLASSIMAGELIST_DATA ClassImageListData, PCSTR MachineName, PVOID Reserved ) ;
+FUNCTION: BOOL SetupDiGetClassImageListExW ( PSP_CLASSIMAGELIST_DATA ClassImageListData, PCWSTR MachineName, PVOID Reserved ) ;
+ALIAS: SetupDiGetClassImageListEx SetupDiGetClassImageListExW
+
+FUNCTION: BOOL SetupDiGetClassImageIndex ( PSP_CLASSIMAGELIST_DATA ClassImageListData, GUID* ClassGuid, PINT ImageIndex ) ;
+FUNCTION: BOOL SetupDiDestroyClassImageList ( PSP_CLASSIMAGELIST_DATA ClassImageListData ) ;
+
+CONSTANT: DIGCDP_FLAG_BASIC HEX: 00000001
+CONSTANT: DIGCDP_FLAG_ADVANCED HEX: 00000002
+CONSTANT: DIGCDP_FLAG_REMOTE_BASIC HEX: 00000003
+CONSTANT: DIGCDP_FLAG_REMOTE_ADVANCED HEX: 00000004
+
+FUNCTION: BOOL SetupDiGetClassDevPropertySheetsA ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, LPPROPSHEETHEADERA PropertySheetHeader, DWORD PropertySheetHeaderPageListSize, PDWORD RequiredSize, DWORD PropertySheetType ) ;
+FUNCTION: BOOL SetupDiGetClassDevPropertySheetsW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, LPPROPSHEETHEADERW PropertySheetHeader, DWORD PropertySheetHeaderPageListSize, PDWORD RequiredSize, DWORD PropertySheetType ) ;
+ALIAS: SetupDiGetClassDevPropertySheets SetupDiGetClassDevPropertySheetsW
+
+CONSTANT: IDI_RESOURCEFIRST 159
+CONSTANT: IDI_RESOURCE 159
+CONSTANT: IDI_RESOURCELAST 161
+CONSTANT: IDI_RESOURCEOVERLAYFIRST 161
+CONSTANT: IDI_RESOURCEOVERLAYLAST 161
+CONSTANT: IDI_CONFLICT 161
+CONSTANT: IDI_CLASSICON_OVERLAYFIRST 500
+CONSTANT: IDI_CLASSICON_OVERLAYLAST 502
+CONSTANT: IDI_PROBLEM_OVL 500
+CONSTANT: IDI_DISABLED_OVL 501
+CONSTANT: IDI_FORCED_OVL 502
+
+FUNCTION: BOOL SetupDiAskForOEMDisk ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData ) ;
+FUNCTION: BOOL SetupDiSelectOEMDrv ( HWND hwndParent, HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData ) ;
+FUNCTION: BOOL SetupDiClassNameFromGuidA ( GUID* ClassGuid, PSTR ClassName, DWORD ClassNameSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupDiClassNameFromGuidW ( GUID* ClassGuid, PWSTR ClassName, DWORD ClassNameSize, PDWORD RequiredSize ) ;
+ALIAS: SetupDiClassNameFromGuid SetupDiClassNameFromGuidW
+
+FUNCTION: BOOL SetupDiClassNameFromGuidExA ( GUID* ClassGuid, PSTR ClassName, DWORD ClassNameSize, PDWORD RequiredSize, PCSTR MachineName, PVOID Reserved ) ;
+FUNCTION: BOOL SetupDiClassNameFromGuidExW ( GUID* ClassGuid, PWSTR ClassName, DWORD ClassNameSize, PDWORD RequiredSize, PCWSTR MachineName, PVOID Reserved ) ;
+ALIAS: SetupDiClassNameFromGuidEx SetupDiClassNameFromGuidExW
+
+FUNCTION: BOOL SetupDiClassGuidsFromNameA ( PCSTR ClassName, LPGUID ClassGuidList, DWORD ClassGuidListSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupDiClassGuidsFromNameW ( PCWSTR ClassName, LPGUID ClassGuidList, DWORD ClassGuidListSize, PDWORD RequiredSize ) ;
+ALIAS: SetupDiClassGuidsFromName SetupDiClassGuidsFromNameW
+
+FUNCTION: BOOL SetupDiClassGuidsFromNameExA ( PCSTR ClassName, LPGUID ClassGuidList, DWORD ClassGuidListSize, PDWORD RequiredSize, PCSTR MachineName, PVOID Reserved ) ;
+FUNCTION: BOOL SetupDiClassGuidsFromNameExW ( PCWSTR ClassName, LPGUID ClassGuidList, DWORD ClassGuidListSize, PDWORD RequiredSize, PCWSTR MachineName, PVOID Reserved ) ;
+ALIAS: SetupDiClassGuidsFromNameEx SetupDiClassGuidsFromNameExW
+
+FUNCTION: BOOL SetupDiGetHwProfileFriendlyNameA ( DWORD HwProfile, PSTR FriendlyName, DWORD FriendlyNameSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupDiGetHwProfileFriendlyNameW ( DWORD HwProfile, PWSTR FriendlyName, DWORD FriendlyNameSize, PDWORD RequiredSize ) ;
+ALIAS: SetupDiGetHwProfileFriendlyName SetupDiGetHwProfileFriendlyNameW
+
+FUNCTION: BOOL SetupDiGetHwProfileFriendlyNameExA ( DWORD HwProfile, PSTR FriendlyName, DWORD FriendlyNameSize, PDWORD RequiredSize, PCSTR MachineName, PVOID Reserved ) ;
+FUNCTION: BOOL SetupDiGetHwProfileFriendlyNameExW ( DWORD HwProfile, PWSTR FriendlyName, DWORD FriendlyNameSize, PDWORD RequiredSize, PCWSTR MachineName, PVOID Reserved ) ;
+ALIAS: SetupDiGetHwProfileFriendlyNameEx SetupDiGetHwProfileFriendlyNameExW
+
+CONSTANT: SPWPT_SELECTDEVICE HEX: 00000001
+CONSTANT: SPWP_USE_DEVINFO_DATA HEX: 00000001
+
+FUNCTION: HPROPSHEETPAGE SetupDiGetWizardPage ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PSP_INSTALLWIZARD_DATA InstallWizardData, DWORD PageType, DWORD Flags ) ;
+FUNCTION: BOOL SetupDiGetSelectedDevice ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData ) ;
+FUNCTION: BOOL SetupDiSetSelectedDevice ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData ) ;
+
+FUNCTION: BOOL SetupDiGetActualModelsSectionA ( PINFCONTEXT Context, PSP_ALTPLATFORM_INFO AlternatePlatformInfo, PSTR InfSectionWithExt, DWORD InfSectionWithExtSize, PDWORD RequiredSize, PVOID Reserved ) ;
+FUNCTION: BOOL SetupDiGetActualModelsSectionW ( PINFCONTEXT Context, PSP_ALTPLATFORM_INFO AlternatePlatformInfo, PWSTR InfSectionWithExt, DWORD InfSectionWithExtSize, PDWORD RequiredSize, PVOID Reserved ) ;
+
+ALIAS: SetupDiGetActualModelsSection SetupDiGetActualModelsSectionW
+
+FUNCTION: BOOL SetupDiGetActualSectionToInstallA ( HINF InfHandle, PCSTR InfSectionName, PSTR InfSectionWithExt, DWORD InfSectionWithExtSize, PDWORD RequiredSize, PSTR* Extension ) ;
+FUNCTION: BOOL SetupDiGetActualSectionToInstallW ( HINF InfHandle, PCWSTR InfSectionName, PWSTR InfSectionWithExt, DWORD InfSectionWithExtSize, PDWORD RequiredSize, PWSTR* Extension ) ;
+ALIAS: SetupDiGetActualSectionToInstall SetupDiGetActualSectionToInstallW
+
+FUNCTION: BOOL SetupDiGetActualSectionToInstallExA ( HINF InfHandle, PCSTR InfSectionName, PSP_ALTPLATFORM_INFO AlternatePlatformInfo, PSTR InfSectionWithExt, DWORD InfSectionWithExtSize, PDWORD RequiredSize, PSTR* Extension, PVOID Reserved ) ;
+FUNCTION: BOOL SetupDiGetActualSectionToInstallExW ( HINF InfHandle, PCWSTR InfSectionName, PSP_ALTPLATFORM_INFO AlternatePlatformInfo, PWSTR InfSectionWithExt, DWORD InfSectionWithExtSize, PDWORD RequiredSize, PWSTR* Extension, PVOID Reserved ) ;
+ALIAS: SetupDiGetActualSectionToInstallEx SetupDiGetActualSectionToInstallExW
+
+FUNCTION: BOOL SetupEnumInfSectionsA ( HINF InfHandle, UINT Index, PSTR Buffer, UINT Size, UINT* SizeNeeded ) ;
+FUNCTION: BOOL SetupEnumInfSectionsW ( HINF InfHandle, UINT Index, PWSTR Buffer, UINT Size, UINT* SizeNeeded ) ;
+ALIAS: SetupEnumInfSections SetupEnumInfSectionsW
+
+STRUCT: SP_INF_SIGNER_INFO_V1_A
+ { cbSize DWORD }
+ { CatalogFile CHAR[MAX_PATH] }
+ { DigitalSigner CHAR[MAX_PATH] }
+ { DigitalSignerVersion CHAR[MAX_PATH] } ;
+TYPEDEF: SP_INF_SIGNER_INFO_V1_A* PSP_INF_SIGNER_INFO_V1_A
+STRUCT: SP_INF_SIGNER_INFO_V1_W
+ { cbSize DWORD }
+ { CatalogFile WCHAR[MAX_PATH] }
+ { DigitalSigner WCHAR[MAX_PATH] }
+ { DigitalSignerVersion WCHAR[MAX_PATH] } ;
+TYPEDEF: SP_INF_SIGNER_INFO_V1_W* PSP_INF_SIGNER_INFO_V1_W
+TYPEDEF: SP_INF_SIGNER_INFO_V1_W SP_INF_SIGNER_INFO_V1
+TYPEDEF: PSP_INF_SIGNER_INFO_V1_W PSP_INF_SIGNER_INFO_V1
+
+STRUCT: SP_INF_SIGNER_INFO_V2_A
+ { cbSize DWORD }
+ { CatalogFile CHAR[MAX_PATH] }
+ { DigitalSigner CHAR[MAX_PATH] }
+ { DigitalSignerVersion CHAR[MAX_PATH] }
+ { SignerScore DWORD } ;
+TYPEDEF: SP_INF_SIGNER_INFO_V2_A* PSP_INF_SIGNER_INFO_V2_A
+STRUCT: SP_INF_SIGNER_INFO_V2_W
+ { cbSize DWORD }
+ { CatalogFile WCHAR[MAX_PATH] }
+ { DigitalSigner WCHAR[MAX_PATH] }
+ { DigitalSignerVersion WCHAR[MAX_PATH] }
+ { SignerScore DWORD } ;
+TYPEDEF: SP_INF_SIGNER_INFO_V2_W* PSP_INF_SIGNER_INFO_V2_W
+
+TYPEDEF: SP_INF_SIGNER_INFO_V2_W SP_INF_SIGNER_INFO_V2
+TYPEDEF: PSP_INF_SIGNER_INFO_V2_W PSP_INF_SIGNER_INFO_V2
+
+CONSTANT: SIGNERSCORE_UNKNOWN HEX: FF000000
+CONSTANT: SIGNERSCORE_W9X_SUSPECT HEX: C0000000
+CONSTANT: SIGNERSCORE_UNSIGNED HEX: 80000000
+CONSTANT: SIGNERSCORE_AUTHENTICODE HEX: 0F000000
+CONSTANT: SIGNERSCORE_WHQL HEX: 0D000005
+CONSTANT: SIGNERSCORE_UNCLASSIFIED HEX: 0D000004
+CONSTANT: SIGNERSCORE_INBOX HEX: 0D000003
+CONSTANT: SIGNERSCORE_LOGO_STANDARD HEX: 0D000002
+CONSTANT: SIGNERSCORE_LOGO_PREMIUM HEX: 0D000001
+CONSTANT: SIGNERSCORE_MASK HEX: FF000000
+CONSTANT: SIGNERSCORE_SIGNED_MASK HEX: F0000000
+
+TYPEDEF: SP_INF_SIGNER_INFO_V2_A SP_INF_SIGNER_INFO_A
+TYPEDEF: PSP_INF_SIGNER_INFO_V2_A PSP_INF_SIGNER_INFO_A
+TYPEDEF: SP_INF_SIGNER_INFO_V2_W SP_INF_SIGNER_INFO_W
+TYPEDEF: PSP_INF_SIGNER_INFO_V2_W PSP_INF_SIGNER_INFO_W
+TYPEDEF: SP_INF_SIGNER_INFO_V2 SP_INF_SIGNER_INFO
+TYPEDEF: PSP_INF_SIGNER_INFO_V2 PSP_INF_SIGNER_INFO
+
+FUNCTION: BOOL SetupVerifyInfFileA ( PCSTR InfName, PSP_ALTPLATFORM_INFO AltPlatformInfo, PSP_INF_SIGNER_INFO_A InfSignerInfo ) ;
+FUNCTION: BOOL SetupVerifyInfFileW ( PCWSTR InfName, PSP_ALTPLATFORM_INFO AltPlatformInfo, PSP_INF_SIGNER_INFO_W InfSignerInfo ) ;
+ALIAS: SetupVerifyInfFile SetupVerifyInfFileW
+
+CONSTANT: DICUSTOMDEVPROP_MERGE_MULTISZ HEX: 00000001
+FUNCTION: BOOL SetupDiGetCustomDevicePropertyA ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PCSTR CustomPropertyName, DWORD Flags, PDWORD PropertyRegDataType, PBYTE PropertyBuffer, DWORD PropertyBufferSize, PDWORD RequiredSize ) ;
+FUNCTION: BOOL SetupDiGetCustomDevicePropertyW ( HDEVINFO DeviceInfoSet, PSP_DEVINFO_DATA DeviceInfoData, PCWSTR CustomPropertyName, DWORD Flags, PDWORD PropertyRegDataType, PBYTE PropertyBuffer, DWORD PropertyBufferSize, PDWORD RequiredSize ) ;
+ALIAS: SetupDiGetCustomDeviceProperty SetupDiGetCustomDevicePropertyW
+
+CONSTANT: SCWMI_CLOBBER_SECURITY HEX: 00000001
+FUNCTION: BOOL SetupConfigureWmiFromInfSectionA ( HINF InfHandle, PCSTR SectionName, DWORD Flags ) ;
+FUNCTION: BOOL SetupConfigureWmiFromInfSectionW ( HINF InfHandle, PCWSTR SectionName, DWORD Flags ) ;
+ALIAS: SetupConfigureWmiFromInfSection SetupConfigureWmiFromInfSectionW
+
--- /dev/null
+Bindings to the SetupAPI section of the Windows DDK.\r
--- /dev/null
+unportable bindings\r
--- /dev/null
+Erik Charlebois
--- /dev/null
+Bindings to the USB section of the Windows DDK.
--- /dev/null
+unportable bindings
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types alien.syntax classes.struct windows.kernel32
+windows.types alien.libraries ;
+IN: windows.ddk.winusb
+
+<< "winusb" "winusb.dll" "stdcall" add-library >>
+LIBRARY: winusb
+
+TYPEDEF: PVOID WINUSB_INTERFACE_HANDLE
+TYPEDEF: WINUSB_INTERFACE_HANDLE* PWINUSB_INTERFACE_HANDLE
+
+STRUCT: USB_INTERFACE_DESCRIPTOR
+ { bLength UCHAR }
+ { bDescriptorType UCHAR }
+ { bInterfaceNumber UCHAR }
+ { bAlternateSetting UCHAR }
+ { bNumEndpoints UCHAR }
+ { bInterfaceClass UCHAR }
+ { bInterfaceSubClass UCHAR }
+ { bInterfaceProtocol UCHAR }
+ { iInterface UCHAR } ;
+TYPEDEF: USB_INTERFACE_DESCRIPTOR* PUSB_INTERFACE_DESCRIPTOR
+
+C-ENUM:
+ UsbdPipeTypeControl
+ UsbdPipeTypeIsochronous
+ UsbdPipeTypeBulk
+ UsbdPipeTypeInterrupt ;
+TYPEDEF: int USBD_PIPE_TYPE
+
+STRUCT: WINUSB_PIPE_INFORMATION
+ { PipeType USBD_PIPE_TYPE }
+ { PipeId UCHAR }
+ { MaximumPacketSize USHORT }
+ { Interval UCHAR } ;
+TYPEDEF: WINUSB_PIPE_INFORMATION* PWINUSB_PIPE_INFORMATION
+
+STRUCT: WINUSB_SETUP_PACKET
+ { RequestType UCHAR }
+ { Request UCHAR }
+ { Value USHORT }
+ { Index USHORT }
+ { Length USHORT } ;
+TYPEDEF: WINUSB_SETUP_PACKET* PWINUSB_SETUP_PACKET
+
+FUNCTION: BOOL WinUsb_AbortPipe ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR PipeID ) ;
+FUNCTION: BOOL WinUsb_FlushPipe ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR PipeID ) ;
+FUNCTION: BOOL WinUsb_ControlTransfer ( WINUSB_INTERFACE_HANDLE InterfaceHandle, WINUSB_SETUP_PACKET SetupPacket, PUCHAR Buffer, ULONG BufferLength, PULONG LengthTransferred, LPOVERLAPPED Overlapped ) ;
+FUNCTION: BOOL WinUsb_Initialize ( HANDLE DeviceHandle, PWINUSB_INTERFACE_HANDLE InterfaceHandle ) ;
+FUNCTION: BOOL WinUsb_Free ( WINUSB_INTERFACE_HANDLE InterfaceHandle ) ;
+FUNCTION: BOOL WinUsb_GetAssociatedInterface ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR AssociatedInterfaceIndex, PWINUSB_INTERFACE_HANDLE AssociatedInterfaceHandle ) ;
+FUNCTION: BOOL WinUsb_GetCurrentAlternateSetting ( WINUSB_INTERFACE_HANDLE InterfaceHandle, PUCHAR SettingNumber ) ;
+FUNCTION: BOOL WinUsb_GetDescriptor ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR DescriptorType, UCHAR Index, USHORT LanguageID, PUCHAR Buffer, ULONG BufferLength, PULONG LengthTransferred ) ;
+FUNCTION: BOOL WinUsb_GetPowerPolicy ( WINUSB_INTERFACE_HANDLE InterfaceHandle, ULONG PolicyType, PULONG ValueLength, PVOID Value ) ;
+FUNCTION: BOOL WinUsb_GetOverlappedResult ( WINUSB_INTERFACE_HANDLE InterfaceHandle, LPOVERLAPPED lpOverlapped, LPDWORD lpNumberOfBytesTransferred, BOOL bWait ) ;
+FUNCTION: BOOL WinUsb_GetPipePolicy ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR PipeID, ULONG PolicyType, PULONG ValueLength, PVOID Value ) ;
+FUNCTION: BOOL WinUsb_QueryInterfaceSettings ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR AlternateInterfaceNumber, PUSB_INTERFACE_DESCRIPTOR UsbAltInterfaceDescriptor ) ;
+FUNCTION: BOOL WinUsb_QueryDeviceInformation ( WINUSB_INTERFACE_HANDLE InterfaceHandle, ULONG InformationType, PULONG BufferLength, PVOID Buffer ) ;
+FUNCTION: BOOL WinUsb_QueryPipe ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR AlternateInterfaceNumber, UCHAR PipeIndex, PWINUSB_PIPE_INFORMATION PipeInformation ) ;
+FUNCTION: BOOL WinUsb_ReadPipe ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR PipeID, PUCHAR Buffer, ULONG BufferLength, PULONG LengthTransferred, LPOVERLAPPED Overlapped ) ;
+FUNCTION: BOOL WinUsb_ResetPipe ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR PipeID ) ;
+FUNCTION: BOOL WinUsb_SetCurrentAlternateSetting ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR SettingNumber ) ;
+FUNCTION: BOOL WinUsb_SetPowerPolicy ( WINUSB_INTERFACE_HANDLE InterfaceHandle, ULONG PolicyType, ULONG ValueLength, PVOID Value ) ;
+FUNCTION: BOOL WinUsb_SetPipePolicy ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR PipeID, ULONG PolicyType, ULONG ValueLength, PVOID Value ) ;
+FUNCTION: BOOL WinUsb_WritePipe ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR PipeID, PUCHAR Buffer, ULONG BufferLength, PULONG LengthTransferred, LPOVERLAPPED Overlapped ) ;
STRUCT: D2D1_FACTORY_OPTIONS
{ debugLevel D2D1_DEBUG_LEVEL } ;
+C-TYPE: ID2D1Factory
+C-TYPE: ID2D1BitmapRenderTarget
+
COM-INTERFACE: ID2D1Resource IUnknown {2cd90691-12e2-11dc-9fed-001143a055f9}
void GetFactory ( ID2D1Factory** factory ) ;
{ bottom UINT }
{ back UINT } ;
+C-TYPE: ID3D10Device
COM-INTERFACE: ID3D10DeviceChild IUnknown {9B7E4C00-342C-4106-A19F-4F2704F689F0}
void GetDevice ( ID3D10Device** ppDevice )
HRESULT GetPrivateData ( LPGUID guid, UINT* pDataSize, void* pData )
USING: alien.c-types alien.syntax classes.struct windows.com
-windows.com.syntax windows.directx.d3d10
+windows.com.syntax windows.directx.d3d10 windows.directx.d3d10misc
windows.directx.d3d10shader windows.types ;
IN: windows.directx.d3d10effect
{ BufferOffset UINT }
{ ExplicitBindPoint UINT } ;
+C-TYPE: ID3D10EffectConstantBuffer
+C-TYPE: ID3D10EffectScalarVariable
+C-TYPE: ID3D10EffectVectorVariable
+C-TYPE: ID3D10EffectMatrixVariable
+C-TYPE: ID3D10EffectStringVariable
+C-TYPE: ID3D10EffectShaderResourceVariable
+C-TYPE: ID3D10EffectRenderTargetViewVariable
+C-TYPE: ID3D10EffectDepthStencilViewVariable
+C-TYPE: ID3D10EffectShaderVariable
+C-TYPE: ID3D10EffectBlendVariable
+C-TYPE: ID3D10EffectDepthStencilVariable
+C-TYPE: ID3D10EffectRasterizerVariable
+C-TYPE: ID3D10EffectSamplerVariable
+
COM-INTERFACE: ID3D10EffectVariable f {AE897105-00E6-45bf-BB8E-281DD6DB8E1B}
BOOL IsValid ( )
ID3D10EffectType* GetType ( )
USING: alien.c-types alien.syntax windows.com windows.com.syntax
-windows.directx.dxgi windows.types alien.libraries ;
+windows.directx.d3d10 windows.directx.dxgi windows.types ;
IN: windows.directx.d3d10misc
LIBRARY: d3d10
-USING: alien.syntax alien.c-types classes.struct windows.types windows.com
-windows.com.syntax windows.directx.d3d10 ;
+USING: alien.c-types alien.syntax classes.struct windows.com
+windows.com.syntax windows.directx.d3d10 windows.directx.d3d10misc
+windows.types ;
IN: windows.directx.d3d10shader
LIBRARY: d3d10
{ bottom UINT }
{ back UINT } ;
+C-TYPE: ID3D11Device
+C-TYPE: ID3D11ClassLinkage
+
COM-INTERFACE: ID3D11DeviceChild IUnknown {1841e5c8-16b0-489b-bcc8-44cfb0d5deae}
void GetDevice ( ID3D11Device** ppDevice )
HRESULT GetPrivateData ( REFGUID guid, UINT* pDataSize, void* pData )
HRESULT IsOfType ( ID3D11ShaderReflectionType* pType )
HRESULT ImplementsInterface ( ID3D11ShaderReflectionType* pBase ) ;
+C-TYPE: ID3D11ShaderReflectionType
+C-TYPE: ID3D11ShaderReflectionConstantBuffer
+
COM-INTERFACE: ID3D11ShaderReflectionVariable f {51F23923-F3E5-4BD1-91CB-606177D8DB4C}
HRESULT GetDesc ( D3D11_SHADER_VARIABLE_DESC* pDesc )
ID3D11ShaderReflectionType* GetType ( )
FUNCTION: void D3DPERF_SetOptions ( DWORD dwOptions ) ;
FUNCTION: DWORD D3DPERF_GetStatus ( ) ;
+C-TYPE: IDirect3DDevice9
+
COM-INTERFACE: IDirect3D9 IUnknown {81BDCBCA-64D4-426d-AE8D-AD0147F4275C}
HRESULT RegisterSoftwareDevice ( void* pInitializeFunction )
UINT GetAdapterCount ( )
C-TYPE: IDirect3DVertexShader9
C-TYPE: IDirect3DIndexBuffer9
C-TYPE: IDirect3DPixelShader9
+C-TYPE: IDirect3DSwapChain9
+C-TYPE: IDirect3DTexture9
+C-TYPE: IDirect3DVolumeTexture9
+C-TYPE: IDirect3DCubeTexture9
+C-TYPE: IDirect3DStateBlock9
+C-TYPE: IDirect3DQuery9
+C-TYPE: IDirect3DVolume9
+C-TYPE: IDirect3D9Ex
+C-TYPE: IDirect3DDevice9Ex
+C-TYPE: IDirect3DAuthenticatedChannel9
+C-TYPE: IDirect3DCryptoSession9
COM-INTERFACE: IDirect3DDevice9 IUnknown {D0223B96-BF7A-43fd-92BD-A43B0D82B9EB}
HRESULT TestCooperativeLevel ( )
CONSTANT: D3DMULTISAMPLE_15_SAMPLES 15
CONSTANT: D3DMULTISAMPLE_16_SAMPLES 16
CONSTANT: D3DMULTISAMPLE_FORCE_DWORD HEX: 7fffffff
-
-:: MAKEFOURCC ( ch0 ch1 ch2 ch3 -- n )
- ch3 HEX: ff bitand 24 shift
- ch2 HEX: ff bitand 16 shift
- ch1 HEX: ff bitand 8 shift
- ch0 HEX: ff bitand bitor bitor bitor ; inline
TYPEDEF: int D3DFORMAT
CONSTANT: D3DFMT_UNKNOWN 0
CONSTANT: D3DFMT_Q8W8V8U8 63
CONSTANT: D3DFMT_V16U16 64
CONSTANT: D3DFMT_A2W10V10U10 67
-#! : D3DFMT_UYVY ( -- n ) 'U' 'Y' 'V' 'Y' MAKEFOURCC
-#! D3DFMT_R8G8_B8G8 = MAKEFOURCC('R', 'G', 'B', 'G'),
-#! D3DFMT_YUY2 = MAKEFOURCC('Y', 'U', 'Y', '2'),
-#! D3DFMT_G8R8_G8B8 = MAKEFOURCC('G', 'R', 'G', 'B'),
-#! D3DFMT_DXT1 = MAKEFOURCC('D', 'X', 'T', '1'),
-#! D3DFMT_DXT2 = MAKEFOURCC('D', 'X', 'T', '2'),
-#! D3DFMT_DXT3 = MAKEFOURCC('D', 'X', 'T', '3'),
-#! D3DFMT_DXT4 = MAKEFOURCC('D', 'X', 'T', '4'),
-#! D3DFMT_DXT5 = MAKEFOURCC('D', 'X', 'T', '5'),
+CONSTANT: D3DFMT_UYVY HEX: 55595659
+CONSTANT: D3DFMT_R8G8_B8G8 HEX: 52474247
+CONSTANT: D3DFMT_YUY2 HEX: 59555932
+CONSTANT: D3DFMT_G8R8_G8B8 HEX: 47524742
+CONSTANT: D3DFMT_DXT1 HEX: 44585431
+CONSTANT: D3DFMT_DXT2 HEX: 44585432
+CONSTANT: D3DFMT_DXT3 HEX: 44585433
+CONSTANT: D3DFMT_DXT4 HEX: 44585434
+CONSTANT: D3DFMT_DXT5 HEX: 44585435
CONSTANT: D3DFMT_D16_LOCKABLE 70
CONSTANT: D3DFMT_D32 71
CONSTANT: D3DFMT_D15S1 73
CONSTANT: D3DFMT_INDEX16 101
CONSTANT: D3DFMT_INDEX32 102
CONSTANT: D3DFMT_Q16W16V16U16 110
-#! D3DFMT_MULTI2_ARGB8 = MAKEFOURCC('M', 'E', 'T', '1'),
+CONSTANT: D3DFMT_MULTI2_ARGB8 HEX: 4d455431
CONSTANT: D3DFMT_R16F 111
CONSTANT: D3DFMT_G16R16F 112
CONSTANT: D3DFMT_A16B16G16R16F 113
-USING: alien.syntax windows.directx.d3d10 windows.directx.d3d10shader
-windows.types ;
+USING: alien.syntax windows.directx.d3d10 windows.directx.d3d10misc
+windows.directx.d3d10shader windows.directx.d3dx10core windows.types ;
IN: windows.directx.d3dx10async
LIBRARY: d3dx10
C-TYPE: ID3D10EffectPool
C-TYPE: D3DX10_IMAGE_LOAD_INFO
C-TYPE: D3DX10_IMAGE_INFO
+C-TYPE: ID3D10Effect
FUNCTION: HRESULT D3DX10CompileFromFileA ( LPCSTR pSrcFile, D3D10_SHADER_MACRO* pDefines, LPD3D10INCLUDE pInclude,
LPCSTR pFunctionName, LPCSTR pProfile, UINT Flags1, UINT Flags2, ID3DX10ThreadPump* pPump, ID3D10Blob** ppShader, ID3D10Blob** ppErrorMsgs, HRESULT* pHResult ) ;
-USING: alien.syntax alien.c-types classes.struct windows.types
-windows.directx.d3d10shader windows.directx.d3dx11core
-windows.directx.d3d11 windows.directx.d3dx11tex ;
+USING: alien.syntax windows.directx.d3d10misc
+windows.directx.d3d10shader windows.directx.d3d11
+windows.directx.d3dx11core windows.directx.d3dx11tex windows.types ;
IN: windows.directx.d3dx11async
LIBRARY: d3dx11
-USING: alien.syntax alien.c-types classes.struct windows.types
-windows.directx.dxgiformat windows.directx.d3d11
-windows.directx.d3dx11core ;
+USING: alien.c-types alien.syntax classes.struct
+windows.directx.d3d10misc windows.directx.d3d11
+windows.directx.d3dx11core windows.directx.dxgiformat windows.types ;
IN: windows.directx.d3dx11tex
LIBRARY: d3dx11
call swap set-global ; inline
: (malloc-guid-symbol) ( symbol guid -- )
- '[
- _ execute( -- value )
- [ byte-length malloc ] [ over byte-array>memory ] bi
- ] initialize ;
+ '[ _ execute( -- value ) malloc-byte-array ] initialize ;
: define-guid-constants ( -- )
{
+++ /dev/null
-unportable
HRESULT GetDC ( BOOL Discard, HDC* phdc )
HRESULT ReleaseDC ( RECT* pDirtyRect ) ;
+C-TYPE: IDXGIOutput
COM-INTERFACE: IDXGIAdapter IDXGIObject {2411e7e1-12ac-4ccf-bd14-9798e8534dc0}
HRESULT EnumOutputs ( UINT Output, IDXGIOutput** ppOutput )
HRESULT GetDesc ( DXGI_ADAPTER_DESC* pDesc )
{ PrimaryCoordinates FLOAT[8][2] }
{ WhitePoints FLOAT[16][2] } ;
+COM-INTERFACE: IDXGIAdapter1 IDXGIAdapter {29038f61-3839-4626-91fd-086879011a05}
+HRESULT GetDesc1 ( DXGI_ADAPTER_DESC1* pDesc ) ;
+
COM-INTERFACE: IDXGIFactory1 IDXGIFactory {770aae78-f26f-4dba-a829-253c83d1b387}
HRESULT EnumAdapters1 ( UINT Adapter, IDXGIAdapter1** ppAdapter )
BOOL IsCurrent ( ) ;
-COM-INTERFACE: IDXGIAdapter1 IDXGIAdapter {29038f61-3839-4626-91fd-086879011a05}
-HRESULT GetDesc1 ( DXGI_ADAPTER_DESC1* pDesc ) ;
-
COM-INTERFACE: IDXGIDevice1 IDXGIDevice {77db970f-6276-48ba-ba28-070143b4392c}
HRESULT SetMaximumFrameLatency ( UINT MaxLatency )
HRESULT GetMaximumFrameLatency ( UINT* pMaxLatency ) ;
-USING: alien.c-types alien.syntax classes.struct windows.ole32
-windows.types ;
+USING: alien.c-types alien.syntax classes.struct windows.com
+windows.ole32 windows.types ;
IN: windows.directx.xapofx
LIBRARY: xapofx
C-TYPE: IXAudio2EngineCallback
C-TYPE: IXAudio2VoiceCallback
+C-TYPE: IXAudio2SourceVoice
+C-TYPE: IXAudio2SubmixVoice
+C-TYPE: IXAudio2MasteringVoice
COM-INTERFACE: IXAudio2 IUnknown {8bcf1f58-9fe7-4583-8ac6-e2adc465c8bb}
HRESULT GetDeviceCount ( UINT32* pCount )
+++ /dev/null
-USING: alien.strings io.encodings.utf16n windows.com\r
-windows.com.wrapper combinators windows.kernel32 windows.ole32\r
-windows.shell32 kernel accessors windows.types\r
-prettyprint namespaces ui.tools.listener ui.tools.workspace\r
-alien.data alien sequences math classes.struct ;\r
-SPECIALIZED-ARRAY: WCHAR\r
-IN: windows.dragdrop-listener\r
-\r
-: filenames-from-hdrop ( hdrop -- filenames )\r
- dup HEX: FFFFFFFF f 0 DragQueryFile ! get count of files\r
- [\r
- 2dup f 0 DragQueryFile 1 + ! get size of filename buffer\r
- dup WCHAR <c-array>\r
- [ swap DragQueryFile drop ] keep\r
- utf16n alien>string\r
- ] with map ;\r
-\r
-: filenames-from-data-object ( data-object -- filenames )\r
- FORMATETC <struct>\r
- CF_HDROP >>cfFormat\r
- f >>ptd\r
- DVASPECT_CONTENT >>dwAspect\r
- -1 >>lindex\r
- TYMED_HGLOBAL >>tymed\r
- STGMEDIUM <struct>\r
- [ IDataObject::GetData ] keep swap succeeded? [\r
- dup data>>\r
- [ filenames-from-hdrop ] with-global-lock\r
- swap ReleaseStgMedium\r
- ] [ drop f ] if ;\r
-\r
-TUPLE: listener-dragdrop hWnd last-drop-effect ;\r
-\r
-: <listener-dragdrop> ( hWnd -- object )\r
- DROPEFFECT_NONE listener-dragdrop construct-boa ;\r
-\r
-SYMBOL: +listener-dragdrop-wrapper+\r
-{\r
- { "IDropTarget" {\r
- [ ! DragEnter\r
- [\r
- 2drop\r
- filenames-from-data-object\r
- length 1 = [ DROPEFFECT_COPY ] [ DROPEFFECT_NONE ] if\r
- dup 0\r
- ] dip set-ulong-nth\r
- >>last-drop-effect drop\r
- S_OK\r
- ] [ ! DragOver\r
- [ 2drop last-drop-effect>> 0 ] dip set-ulong-nth\r
- S_OK\r
- ] [ ! DragLeave\r
- drop S_OK\r
- ] [ ! Drop\r
- [\r
- 2drop nip\r
- filenames-from-data-object\r
- dup length 1 = [\r
- first unparse [ "USE: parser " % % " run-file" % ] "" make\r
- eval-listener\r
- DROPEFFECT_COPY\r
- ] [ 2drop DROPEFFECT_NONE ] if\r
- 0\r
- ] dip set-ulong-nth\r
- S_OK\r
- ]\r
- } }\r
-} <com-wrapper> +listener-dragdrop-wrapper+ set-global\r
-\r
-: dragdrop-listener-window ( -- )\r
- get-workspace parent>> handle>> hWnd>>\r
- dup <listener-dragdrop>\r
- +listener-dragdrop-wrapper+ get-global com-wrap\r
- [ RegisterDragDrop ole32-error ] with-com-interface ;\r
+++ /dev/null
-unportable
SPECIALIZED-ARRAY: TCHAR
IN: windows.errors
+CONSTANT: APPLICATION_ERROR_MASK HEX: 20000000
+CONSTANT: ERROR_SEVERITY_SUCCESS HEX: 00000000
+CONSTANT: ERROR_SEVERITY_INFORMATIONAL HEX: 40000000
+CONSTANT: ERROR_SEVERITY_WARNING HEX: 80000000
+CONSTANT: ERROR_SEVERITY_ERROR HEX: C0000000
+
CONSTANT: ERROR_SUCCESS 0
CONSTANT: ERROR_INVALID_FUNCTION 1
CONSTANT: ERROR_FILE_NOT_FOUND 2
+++ /dev/null
-unportable
+++ /dev/null
-unportable
! Copyright (C) 2005, 2006 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax kernel windows.types
-multiline classes.struct ;
+math multiline classes.struct ;
IN: windows.kernel32
CONSTANT: MAX_PATH 260
CONSTANT: FILE_ACTION_RENAMED_OLD_NAME 4
CONSTANT: FILE_ACTION_RENAMED_NEW_NAME 5
+CONSTANT: DONT_RESOLVE_DLL_REFERENCES 1
+
STRUCT: FILE_NOTIFY_INFORMATION
{ NextEntryOffset DWORD }
{ Action DWORD }
CONSTANT: STATUS_FLOAT_MULTIPLE_FAULTS HEX: C00002B4
CONSTANT: STATUS_FLOAT_MULTIPLE_TRAPS HEX: C00002B5
+! Resource IDs
+: MAKEINTRESOURCE ( int -- resource ) HEX: ffff bitand <alien> ; inline
+
+: RT_CURSOR ( -- id ) 1 MAKEINTRESOURCE ; inline
+: RT_BITMAP ( -- id ) 2 MAKEINTRESOURCE ; inline
+: RT_ICON ( -- id ) 3 MAKEINTRESOURCE ; inline
+: RT_MENU ( -- id ) 4 MAKEINTRESOURCE ; inline
+: RT_DIALOG ( -- id ) 5 MAKEINTRESOURCE ; inline
+: RT_STRING ( -- id ) 6 MAKEINTRESOURCE ; inline
+: RT_FONTDIR ( -- id ) 7 MAKEINTRESOURCE ; inline
+: RT_FONT ( -- id ) 8 MAKEINTRESOURCE ; inline
+: RT_ACCELERATOR ( -- id ) 9 MAKEINTRESOURCE ; inline
+: RT_RCDATA ( -- id ) 10 MAKEINTRESOURCE ; inline
+: RT_MESSAGETABLE ( -- id ) 11 MAKEINTRESOURCE ; inline
+: RT_GROUP_CURSOR ( -- id ) 12 MAKEINTRESOURCE ; inline
+: RT_GROUP_ICON ( -- id ) 14 MAKEINTRESOURCE ; inline
+: RT_VERSION ( -- id ) 16 MAKEINTRESOURCE ; inline
+: RT_DLGINCLUDE ( -- id ) 17 MAKEINTRESOURCE ; inline
+: RT_PLUGPLAY ( -- id ) 19 MAKEINTRESOURCE ; inline
+: RT_VXD ( -- id ) 20 MAKEINTRESOURCE ; inline
+: RT_ANICURSOR ( -- id ) 21 MAKEINTRESOURCE ; inline
+: RT_ANIICON ( -- id ) 22 MAKEINTRESOURCE ; inline
+: RT_MANIFEST ( -- id ) 24 MAKEINTRESOURCE ; inline
+
LIBRARY: kernel32
! FUNCTION: _hread
! FUNCTION: _hwrite
! FUNCTION: BaseUpdateAppcompatCache
! FUNCTION: Beep
! FUNCTION: BeginUpdateResourceA
-! FUNCTION: BeginUpdateResourceW
+FUNCTION: HANDLE BeginUpdateResourceW ( LPCTSTR pFileName, BOOL bDeleteExistingResources ) ;
+ALIAS: BeginUpdateResource BeginUpdateResourceW
! FUNCTION: BindIoCompletionCallback
! FUNCTION: BuildCommDCBA
! FUNCTION: BuildCommDCBAndTimeoutsA
! FUNCTION: EncodePointer
! FUNCTION: EncodeSystemPointer
! FUNCTION: EndUpdateResourceA
-! FUNCTION: EndUpdateResourceW
+FUNCTION: BOOL EndUpdateResourceW ( HANDLE hUpdate, BOOL fDiscard ) ;
+ALIAS: EndUpdateResource EndUpdateResourceW
! FUNCTION: EnterCriticalSection
! FUNCTION: EnumCalendarInfoA
! FUNCTION: EnumCalendarInfoExA
! FUNCTION: FreeEnvironmentStringsA
FUNCTION: BOOL FreeEnvironmentStringsW ( LPTCH lpszEnvironmentBlock ) ;
ALIAS: FreeEnvironmentStrings FreeEnvironmentStringsW
-! FUNCTION: FreeLibrary
+FUNCTION: BOOL FreeLibrary ( HMODULE hModule ) ;
! FUNCTION: FreeLibraryAndExitThread
! FUNCTION: FreeResource
! FUNCTION: FreeUserPhysicalPages
! FUNCTION: GetLongPathNameW
! FUNCTION: GetMailslotInfo
! FUNCTION: GetModuleFileNameA
-! FUNCTION: GetModuleFileNameW
+FUNCTION: DWORD GetModuleFileNameW ( HMODULE hModule, LPTSTR lpFilename, DWORD nSize ) ;
+ALIAS: GetModuleFileName GetModuleFileNameW
FUNCTION: HMODULE GetModuleHandleW ( LPCWSTR lpModuleName ) ;
ALIAS: GetModuleHandle GetModuleHandleW
! FUNCTION: GetModuleHandleExA
! FUNCTION: GetPrivateProfileStringW
! FUNCTION: GetPrivateProfileStructA
! FUNCTION: GetPrivateProfileStructW
-FUNCTION: LPVOID GetProcAddress ( HMODULE hModule, char* lpProcName ) ;
+FUNCTION: LPVOID GetProcAddress ( HMODULE hModule, c-string lpProcName ) ;
! FUNCTION: GetProcessAffinityMask
! FUNCTION: GetProcessHandleCount
! FUNCTION: GetProcessHeap
! FUNCTION: UnregisterWait
! FUNCTION: UnregisterWaitEx
! FUNCTION: UpdateResourceA
-! FUNCTION: UpdateResourceW
+FUNCTION: BOOL UpdateResourceW ( HANDLE hUpdate, LPCTSTR lpType, LPCTSTR lpName, WORD wLanguage, LPVOID lpData, DWORD cbData ) ;
+ALIAS: UpdateResource UpdateResourceW
! FUNCTION: UTRegister
! FUNCTION: UTUnRegister
! FUNCTION: ValidateLCType
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable\r
TYPEDEF: GUID* REFGUID
TYPEDEF: void* LPUNKNOWN
-TYPEDEF: wchar_t* LPOLESTR
-TYPEDEF: wchar_t* LPCOLESTR
+TYPEDEF: LPWSTR LPOLESTR
+TYPEDEF: LPWSTR LPCOLESTR
TYPEDEF: REFGUID LPGUID
TYPEDEF: REFGUID REFIID
+++ /dev/null
-unportable
! WGL_ARB_extensions_string extension
-GL-FUNCTION: char* wglGetExtensionsStringARB { } ( HDC hDC ) ;
+GL-FUNCTION: c-string wglGetExtensionsStringARB { } ( HDC hDC ) ;
! WGL_ARB_pixel_format extension
+++ /dev/null
-unportable
FUNCTION: HINSTANCE ShellExecuteW ( HWND hwnd, LPCTSTR lpOperation, LPCTSTR lpFile, LPCTSTR lpParameters, LPCTSTR lpDirectory, INT nShowCmd ) ;
ALIAS: ShellExecute ShellExecuteW
-: open-in-explorer ( dir -- )
- [ f "open" ] dip absolute-path f f SW_SHOWNORMAL ShellExecute drop ;
-
: shell32-directory ( n -- str )
f swap f SHGFP_TYPE_DEFAULT
MAX_UNICODE_PATH <ushort-array>
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
TYPEDEF: uchar BYTE
TYPEDEF: ushort wchar_t
-SYMBOL: wchar_t*
-<<
-{ char* utf16n } \ wchar_t* typedef
-\ wchar_t \ wchar_t* "pointer-c-type" set-word-prop
->>
TYPEDEF: wchar_t WCHAR
TYPEDEF: size_t SIZE_T
TYPEDEF: ptrdiff_t SSIZE_T
-TYPEDEF: wchar_t* LPCSTR
-TYPEDEF: wchar_t* LPWSTR
+TYPEDEF: { c-string utf16n } LPCSTR
+TYPEDEF: { c-string utf16n } LPWSTR
TYPEDEF: WCHAR TCHAR
TYPEDEF: LPWSTR LPTCH
TYPEDEF: LPWSTR PTCH
TYPEDEF: LONG_PTR LPARAM
TYPEDEF: BOOL* LPBOOL
TYPEDEF: BYTE* LPBYTE
-TYPEDEF: WCHAR* LPCWSTR
+TYPEDEF: { c-string utf16n } LPCWSTR
! TYPEDEF: WCHAR* LPWSTR
-TYPEDEF: WCHAR* LPSTR
-TYPEDEF: wchar_t* LPCTSTR
-TYPEDEF: wchar_t* LPWTSTR
+TYPEDEF: { c-string utf16n } LPSTR
+TYPEDEF: { c-string utf16n } LPCTSTR
+TYPEDEF: { c-string utf16n } LPWTSTR
-TYPEDEF: wchar_t* LPTSTR
+TYPEDEF: { c-string utf16n } LPTSTR
TYPEDEF: LPCSTR PCTSTR
TYPEDEF: LPSTR PTSTR
TYPEDEF: BYTE* PBYTE
TYPEDEF: CHAR* PCHAR
TYPEDEF: CHAR* PCSTR
-TYPEDEF: WCHAR* PCWSTR
+TYPEDEF: { c-string utf16n } PCWSTR
TYPEDEF: DWORD* PDWORD
TYPEDEF: DWORDLONG* PDWORDLONG
TYPEDEF: DWORD_PTR* PDWORD_PTR
TYPEDEF: ULONG32* PULONG32
TYPEDEF: ULONG64* PULONG64
TYPEDEF: USHORT* PUSHORT
-TYPEDEF: WCHAR* PWCHAR
+TYPEDEF: { c-string utf16n } PWCHAR
TYPEDEF: WORD* PWORD
-TYPEDEF: WCHAR* PWSTR
+TYPEDEF: { c-string utf16n } PWSTR
TYPEDEF: HANDLE SC_HANDLE
TYPEDEF: LPVOID SC_LOCK
TYPEDEF: HANDLE SERVICE_STATUS_HANDLE
STRUCT: LVFINDINFO
{ flags uint }
- { psz char* }
+ { psz c-string }
{ lParam long }
{ pt POINT }
{ vkDirection uint } ;
+++ /dev/null
-unportable\r
: script-string-size ( script-string -- dim )
ssa>> ScriptString_pSize
dup win32-error=0/f
- SIZE memory>struct
[ cx>> ] [ cy>> ] bi 2array ;
: dc-metrics ( dc -- metrics )
+++ /dev/null
-unportable
CONSTANT: MF_RIGHTJUSTIFY HEX: 4000
CONSTANT: MF_MOUSESELECT HEX: 8000
+CONSTANT: SPI_GETBEEP 1
+CONSTANT: SPI_SETBEEP 2
+CONSTANT: SPI_GETMOUSE 3
+CONSTANT: SPI_SETMOUSE 4
+CONSTANT: SPI_GETBORDER 5
+CONSTANT: SPI_SETBORDER 6
+CONSTANT: SPI_GETKEYBOARDSPEED 10
+CONSTANT: SPI_SETKEYBOARDSPEED 11
+CONSTANT: SPI_LANGDRIVER 12
+CONSTANT: SPI_ICONHORIZONTALSPACING 13
+CONSTANT: SPI_GETSCREENSAVETIMEOUT 14
+CONSTANT: SPI_SETSCREENSAVETIMEOUT 15
+CONSTANT: SPI_GETSCREENSAVEACTIVE 16
+CONSTANT: SPI_SETSCREENSAVEACTIVE 17
+CONSTANT: SPI_GETGRIDGRANULARITY 18
+CONSTANT: SPI_SETGRIDGRANULARITY 19
+CONSTANT: SPI_SETDESKWALLPAPER 20
+CONSTANT: SPI_SETDESKPATTERN 21
+CONSTANT: SPI_GETKEYBOARDDELAY 22
+CONSTANT: SPI_SETKEYBOARDDELAY 23
+CONSTANT: SPI_ICONVERTICALSPACING 24
+CONSTANT: SPI_GETICONTITLEWRAP 25
+CONSTANT: SPI_SETICONTITLEWRAP 26
+CONSTANT: SPI_GETMENUDROPALIGNMENT 27
+CONSTANT: SPI_SETMENUDROPALIGNMENT 28
+CONSTANT: SPI_SETDOUBLECLKWIDTH 29
+CONSTANT: SPI_SETDOUBLECLKHEIGHT 30
+CONSTANT: SPI_GETICONTITLELOGFONT 31
+CONSTANT: SPI_SETDOUBLECLICKTIME 32
+CONSTANT: SPI_SETMOUSEBUTTONSWAP 33
+CONSTANT: SPI_SETICONTITLELOGFONT 34
+CONSTANT: SPI_GETFASTTASKSWITCH 35
+CONSTANT: SPI_SETFASTTASKSWITCH 36
+CONSTANT: SPI_SETDRAGFULLWINDOWS 37
+CONSTANT: SPI_GETDRAGFULLWINDOWS 38
+
+CONSTANT: SPI_GETFILTERKEYS 50
+CONSTANT: SPI_SETFILTERKEYS 51
+CONSTANT: SPI_GETTOGGLEKEYS 52
+CONSTANT: SPI_SETTOGGLEKEYS 53
+CONSTANT: SPI_GETMOUSEKEYS 54
+CONSTANT: SPI_SETMOUSEKEYS 55
+CONSTANT: SPI_GETSHOWSOUNDS 56
+CONSTANT: SPI_SETSHOWSOUNDS 57
+CONSTANT: SPI_GETSTICKYKEYS 58
+CONSTANT: SPI_SETSTICKYKEYS 59
+CONSTANT: SPI_GETACCESSTIMEOUT 60
+CONSTANT: SPI_SETACCESSTIMEOUT 61
+
+CONSTANT: SPI_GETSOUNDSENTRY 64
+CONSTANT: SPI_SETSOUNDSENTRY 65
+
+! WINVER >= 0x0400
+CONSTANT: SPI_GETNONCLIENTMETRICS 41
+CONSTANT: SPI_SETNONCLIENTMETRICS 42
+CONSTANT: SPI_GETMINIMIZEDMETRICS 43
+CONSTANT: SPI_SETMINIMIZEDMETRICS 44
+CONSTANT: SPI_GETICONMETRICS 45
+CONSTANT: SPI_SETICONMETRICS 46
+CONSTANT: SPI_SETWORKAREA 47
+CONSTANT: SPI_GETWORKAREA 48
+CONSTANT: SPI_SETPENWINDOWS 49
+
+CONSTANT: SPI_GETSERIALKEYS 62
+CONSTANT: SPI_SETSERIALKEYS 63
+CONSTANT: SPI_GETHIGHCONTRAST 66
+CONSTANT: SPI_SETHIGHCONTRAST 67
+CONSTANT: SPI_GETKEYBOARDPREF 68
+CONSTANT: SPI_SETKEYBOARDPREF 69
+CONSTANT: SPI_GETSCREENREADER 70
+CONSTANT: SPI_SETSCREENREADER 71
+CONSTANT: SPI_GETANIMATION 72
+CONSTANT: SPI_SETANIMATION 73
+CONSTANT: SPI_GETFONTSMOOTHING 74
+CONSTANT: SPI_SETFONTSMOOTHING 75
+CONSTANT: SPI_SETDRAGWIDTH 76
+CONSTANT: SPI_SETDRAGHEIGHT 77
+CONSTANT: SPI_SETHANDHELD 78
+CONSTANT: SPI_GETLOWPOWERTIMEOUT 79
+CONSTANT: SPI_GETPOWEROFFTIMEOUT 80
+CONSTANT: SPI_SETLOWPOWERTIMEOUT 81
+CONSTANT: SPI_SETPOWEROFFTIMEOUT 82
+CONSTANT: SPI_GETLOWPOWERACTIVE 83
+CONSTANT: SPI_GETPOWEROFFACTIVE 84
+CONSTANT: SPI_SETLOWPOWERACTIVE 85
+CONSTANT: SPI_SETPOWEROFFACTIVE 86
+CONSTANT: SPI_SETCURSORS 87
+CONSTANT: SPI_SETICONS 88
+CONSTANT: SPI_GETDEFAULTINPUTLANG 89
+CONSTANT: SPI_SETDEFAULTINPUTLANG 90
+CONSTANT: SPI_SETLANGTOGGLE 91
+CONSTANT: SPI_GETWINDOWSEXTENSION 92
+CONSTANT: SPI_SETMOUSETRAILS 93
+CONSTANT: SPI_GETMOUSETRAILS 94
+CONSTANT: SPI_SETSCREENSAVERRUNNING 97
+ALIAS: SPI_SCREENSAVERRUNNING SPI_SETSCREENSAVERRUNNING
+
+! WIN32_WINNT >= 0x0400 || WIN32_WINDOWS > 0x0400
+CONSTANT: SPI_GETMOUSEHOVERWIDTH 98
+CONSTANT: SPI_SETMOUSEHOVERWIDTH 99
+CONSTANT: SPI_GETMOUSEHOVERHEIGHT 100
+CONSTANT: SPI_SETMOUSEHOVERHEIGHT 101
+CONSTANT: SPI_GETMOUSEHOVERTIME 102
+CONSTANT: SPI_SETMOUSEHOVERTIME 103
+CONSTANT: SPI_GETWHEELSCROLLLINES 104
+CONSTANT: SPI_SETWHEELSCROLLLINES 105
+
+CONSTANT: SPI_GETSHOWIMEUI 110
+CONSTANT: SPI_SETSHOWIMEUI 111
+
+! WINVER >= 0x0500
+CONSTANT: SPI_GETMOUSESPEED 112
+CONSTANT: SPI_SETMOUSESPEED 113
+CONSTANT: SPI_GETSCREENSAVERRUNNING 114
+
+CONSTANT: SPI_GETACTIVEWINDOWTRACKING HEX: 1000
+CONSTANT: SPI_SETACTIVEWINDOWTRACKING HEX: 1001
+CONSTANT: SPI_GETMENUANIMATION HEX: 1002
+CONSTANT: SPI_SETMENUANIMATION HEX: 1003
+CONSTANT: SPI_GETCOMBOBOXANIMATION HEX: 1004
+CONSTANT: SPI_SETCOMBOBOXANIMATION HEX: 1005
+CONSTANT: SPI_GETLISTBOXSMOOTHSCROLLING HEX: 1006
+CONSTANT: SPI_SETLISTBOXSMOOTHSCROLLING HEX: 1007
+CONSTANT: SPI_GETGRADIENTCAPTIONS HEX: 1008
+CONSTANT: SPI_SETGRADIENTCAPTIONS HEX: 1009
+CONSTANT: SPI_GETMENUUNDERLINES HEX: 100A
+CONSTANT: SPI_SETMENUUNDERLINES HEX: 100B
+CONSTANT: SPI_GETACTIVEWNDTRKZORDER HEX: 100C
+CONSTANT: SPI_SETACTIVEWNDTRKZORDER HEX: 100D
+CONSTANT: SPI_GETHOTTRACKING HEX: 100E
+CONSTANT: SPI_SETHOTTRACKING HEX: 100F
+CONSTANT: SPI_GETFOREGROUNDLOCKTIMEOUT HEX: 2000
+CONSTANT: SPI_SETFOREGROUNDLOCKTIMEOUT HEX: 2001
+CONSTANT: SPI_GETACTIVEWNDTRKTIMEOUT HEX: 2002
+CONSTANT: SPI_SETACTIVEWNDTRKTIMEOUT HEX: 2003
+CONSTANT: SPI_GETFOREGROUNDFLASHCOUNT HEX: 2004
+CONSTANT: SPI_SETFOREGROUNDFLASHCOUNT HEX: 2005
+
+! SystemParamInfo Flags
+CONSTANT: SPIF_UPDATEINIFILE 1
+CONSTANT: SPIF_SENDWININICHANGE 2
+ALIAS: SPIF_SENDCHANGE SPIF_SENDWININICHANGE
+
+
TYPEDEF: HANDLE HRAWINPUT
: GET_RAWINPUT_CODE_WPARAM ( wParam -- n ) HEX: ff bitand ; inline
{ dwType DWORD } ;
TYPEDEF: RAWINPUTDEVICELIST* PRAWINPUTDEVICELIST
+CONSTANT: CCHFORMNAME 32
+
+CONSTANT: CDS_UPDATEREGISTRY HEX: 00000001
+CONSTANT: CDS_TEST HEX: 00000002
+CONSTANT: CDS_FULLSCREEN HEX: 00000004
+CONSTANT: CDS_GLOBAL HEX: 00000008
+CONSTANT: CDS_SET_PRIMARY HEX: 00000010
+CONSTANT: CDS_RESET HEX: 40000000
+CONSTANT: CDS_SETRECT HEX: 20000000
+CONSTANT: CDS_NORESET HEX: 10000000
+
+CONSTANT: DISP_CHANGE_SUCCESSFUL 0
+CONSTANT: DISP_CHANGE_RESTART 1
+CONSTANT: DISP_CHANGE_FAILED -1
+CONSTANT: DISP_CHANGE_BADMODE -2
+CONSTANT: DISP_CHANGE_NOTUPDATED -3
+CONSTANT: DISP_CHANGE_BADFLAGS -4
+CONSTANT: DISP_CHANGE_BADPARAM -5
+
+
+
+STRUCT: DEVMODE
+ { dmDeviceName TCHAR[CCHDEVICENAME] }
+ { dmSpecVersion WORD }
+ { dmDriverVersion WORD }
+ { dmSize WORD }
+ { dmDriverExtra WORD }
+ { dmFields DWORD }
+
+ { dmOrientation short }
+ { dmPaperSize short }
+ { dmPaperLength short }
+ { dmPaperWidth short }
+ { dmScale short }
+ { dmCopies short }
+ { dmDefaultSource short }
+ { dmPrintQuality short }
+
+ { dmColor short }
+ { dmDuplex short }
+ { dmYResolution short }
+ { dmTTOption short }
+ { dmCollate short }
+ { dmFormName TCHAR[CCHFORMNAME] }
+ { dmLogPixels WORD }
+ { dmBitsPerPel DWORD }
+ { dmPelsWidth DWORD }
+ { dmPelsHeight DWORD }
+ { dmDisplayFlags DWORD }
+ { dmDisplayFrequency DWORD }
+ { dmiCMMethod DWORD }
+ { dmICMIntent DWORD }
+
+ { dmMediaType DWORD }
+ { dmDitherType DWORD }
+ { dmReserved1 DWORD }
+ { dmReserved2 DWORD }
+ { dmPanningWidth DWORD } ;
+
+! union { DWORD dmDisplayFlags; DWORD dmNup; } ;
+ ! union {
+ ! struct {
+ ! short dmOrientation;
+ ! short dmPaperSize;
+ ! short dmPaperLength;
+ ! short dmPaperWidth;
+ ! short dmScale;
+ ! short dmCopies;
+ ! short dmDefaultSource;
+ ! short dmPrintQuality;
+ ! } ;
+ ! struct {
+ ! POINTL dmPosition;
+ ! DWORD dmDisplayOrientation;
+ ! DWORD dmDisplayFixedOutput;
+ ! } ;
+ ! } ;
+
+TYPEDEF: DEVMODE* PDEVMODE
+TYPEDEF: DEVMODE* LPDEVMODE
+
LIBRARY: user32
FUNCTION: HKL ActivateKeyboardLayout ( HKL hkl, UINT Flags ) ;
! FUNCTION: CascadeChildWindows
! FUNCTION: CascadeWindows
! FUNCTION: ChangeClipboardChain
-! FUNCTION: ChangeDisplaySettingsA
-! FUNCTION: ChangeDisplaySettingsExA
-! FUNCTION: ChangeDisplaySettingsExW
-! FUNCTION: ChangeDisplaySettingsW
+FUNCTION: LONG ChangeDisplaySettingsExW ( LPCTSTR lpszDeviceName, DEVMODE *lpDevMode, HWND hwnd, DWORD dwFlags, LPVOID lParam ) ;
+FUNCTION: LONG ChangeDisplaySettingsW ( DEVMODE *lpDevMode, DWORD dwFlags ) ;
+ALIAS: ChangeDisplaySettingsEx ChangeDisplaySettingsExW
+ALIAS: ChangeDisplaySettings ChangeDisplaySettingsW
! FUNCTION: ChangeMenuA
! FUNCTION: ChangeMenuW
! FUNCTION: CharLowerA
! FUNCTION: EnumDisplaySettingsA
! FUNCTION: EnumDisplaySettingsExA
! FUNCTION: EnumDisplaySettingsExW
-! FUNCTION: EnumDisplaySettingsW
+FUNCTION: BOOL EnumDisplaySettingsW ( LPCTSTR lpszDeviceName, DWORD iModeNum, DEVMODE *lpDevMode ) ;
+ALIAS: EnumDisplaySettings EnumDisplaySettingsW
! FUNCTION: EnumPropsA
! FUNCTION: EnumPropsExA
! FUNCTION: EnumPropsExW
! FUNCTION: ExcludeUpdateRgn
! FUNCTION: ExitWindowsEx
FUNCTION: int FillRect ( HDC hDC, RECT* lprc, HBRUSH hbr ) ;
-FUNCTION: HWND FindWindowA ( char* lpClassName, char* lpWindowName ) ;
-FUNCTION: HWND FindWindowExA ( HWND hwndParent, HWND childAfter, char* lpClassName, char* lpWindowName ) ;
+FUNCTION: HWND FindWindowA ( c-string lpClassName, c-string lpWindowName ) ;
+FUNCTION: HWND FindWindowExA ( HWND hwndParent, HWND childAfter, c-string lpClassName, c-string lpWindowName ) ;
! FUNCTION: FindWindowExW
! FUNCTION: FindWindowW
! FUNCTION: FlashWindow
! FUNCTION: GetCursorPos
FUNCTION: HDC GetDC ( HWND hWnd ) ;
FUNCTION: HDC GetDCEx ( HWND hWnd, HRGN hrgnClip, DWORD flags ) ;
-! FUNCTION: GetDesktopWindow
+FUNCTION: HWND GetDesktopWindow ( ) ;
! FUNCTION: GetDialogBaseUnits
! FUNCTION: GetDlgCtrlID
! FUNCTION: GetDlgItem
! FUNCTION: GetWindowLongW
FUNCTION: LONG_PTR GetWindowLongW ( HANDLE hWnd, int index ) ;
ALIAS: GetWindowLong GetWindowLongW
+
+FUNCTION: LONG_PTR GetWindowLongPtr ( HWND hWnd, int nIndex ) ;
! FUNCTION: GetWindowModuleFileName
! FUNCTION: GetWindowModuleFileNameA
! FUNCTION: GetWindowModuleFileNameW
! FUNCTION: SetWindowPlacement
FUNCTION: BOOL SetWindowPos ( HWND hWnd, HWND hWndInsertAfter, int X, int Y, int cx, int cy, UINT uFlags ) ;
+FUNCTION: LONG_PTR SetWindowLongPtr ( HWND hWnd, int nIndex, LONG_PTR dwNewLong ) ;
+
: HWND_BOTTOM ( -- alien ) 1 <alien> ;
: HWND_NOTOPMOST ( -- alien ) -2 <alien> ;
CONSTANT: HWND_TOP f
! FUNCTION: SwitchDesktop
! FUNCTION: SwitchToThisWindow
! FUNCTION: SystemParametersInfoA
-! FUNCTION: SystemParametersInfoW
+
+FUNCTION: BOOL SystemParametersInfoW ( UINT uiAction, UINT uiParam, PVOID pvParam, UINT fWinIni ) ;
+ALIAS: SystemParametersInfo SystemParametersInfoW
+
! FUNCTION: TabbedTextOutA
! FUNCTION: TabbedTextOutW
! FUNCTION: TileChildWindows
STRUCT: SCRIPT_VISATTR
{ flags WORD } ;
-TYPEDEF: void* SCRIPT_CACHE*
+C-TYPE: SCRIPT_CACHE
C-TYPE: ABC
FUNCTION: HRESULT ScriptShape (
+++ /dev/null
-unportable
{ scopeid uint } ;
STRUCT: hostent
- { name char* }
+ { name c-string }
{ aliases void* }
{ addrtype short }
{ length short }
{ socktype int }
{ protocol int }
{ addrlen size_t }
- { canonname char* }
+ { canonname c-string }
{ addr sockaddr* }
{ next addrinfo* } ;
{ sec long }
{ usec long } ;
-TYPEDEF: void* fd_set*
+C-TYPE: fd_set
LIBRARY: winsock
-FUNCTION: int setsockopt ( SOCKET s, int level, int optname, char* optval, int optlen ) ;
+FUNCTION: int setsockopt ( SOCKET s, int level, int optname, c-string optval, int optlen ) ;
FUNCTION: ushort htons ( ushort n ) ;
FUNCTION: ushort ntohs ( ushort n ) ;
FUNCTION: int bind ( void* socket, sockaddr-in* sockaddr, int len ) ;
FUNCTION: int listen ( void* socket, int backlog ) ;
-FUNCTION: char* inet_ntoa ( int in-addr ) ;
-FUNCTION: int getaddrinfo ( char* nodename,
- char* servername,
+FUNCTION: c-string inet_ntoa ( int in-addr ) ;
+FUNCTION: int getaddrinfo ( c-string nodename,
+ c-string servername,
addrinfo* hints,
addrinfo** res ) ;
FUNCTION: void freeaddrinfo ( addrinfo* ai ) ;
-FUNCTION: hostent* gethostbyname ( char* name ) ;
-FUNCTION: int gethostname ( char* name, int len ) ;
+FUNCTION: hostent* gethostbyname ( c-string name ) ;
+FUNCTION: int gethostname ( c-string name, int len ) ;
FUNCTION: int connect ( void* socket, sockaddr-in* sockaddr, int addrlen ) ;
FUNCTION: int select ( int nfds, fd_set* readfds, fd_set* writefds, fd_set* exceptfds, timeval* timeout ) ;
FUNCTION: int closesocket ( SOCKET s ) ;
FUNCTION: int shutdown ( SOCKET s, int how ) ;
-FUNCTION: int send ( SOCKET s, char* buf, int len, int flags ) ;
-FUNCTION: int recv ( SOCKET s, char* buf, int len, int flags ) ;
+FUNCTION: int send ( SOCKET s, c-string buf, int len, int flags ) ;
+FUNCTION: int recv ( SOCKET s, c-string buf, int len, int flags ) ;
FUNCTION: int getsockname ( SOCKET s, sockaddr-in* address, int* addrlen ) ;
FUNCTION: int getpeername ( SOCKET s, sockaddr-in* address, int* addrlen ) ;
X-FUNCTION: void glXUseXFont ( Font font, int first, int count, int listBase ) ;
X-FUNCTION: void glXWaitGL ( ) ;
X-FUNCTION: void glXWaitX ( ) ;
-X-FUNCTION: char* glXGetClientString ( Display* dpy, int name ) ;
-X-FUNCTION: char* glXQueryServerString ( Display* dpy, int screen, int name ) ;
-X-FUNCTION: char* glXQueryExtensionsString ( Display* dpy, int screen ) ;
+X-FUNCTION: c-string glXGetClientString ( Display* dpy, int name ) ;
+X-FUNCTION: c-string glXQueryServerString ( Display* dpy, int screen, int name ) ;
+X-FUNCTION: c-string glXQueryExtensionsString ( Display* dpy, int screen ) ;
! New for GLX 1.3
X-FUNCTION: GLXFBConfig* glXGetFBConfigs ( Display* dpy, int screen, int* nelements ) ;
X-FUNCTION: void glXGetSelectedEvent ( Display* dpy, GLXDrawable draw, ulong* event_mask ) ;
! GLX 1.4 and later
-X-FUNCTION: void* glXGetProcAddress ( char* procname ) ;
+X-FUNCTION: void* glXGetProcAddress ( c-string procname ) ;
! GLX_ARB_get_proc_address extension
-X-FUNCTION: void* glXGetProcAddressARB ( char* procname ) ;
+X-FUNCTION: void* glXGetProcAddressARB ( c-string procname ) ;
! GLX_ARB_multisample
CONSTANT: GLX_SAMPLE_BUFFERS 100000
+++ /dev/null
-unportable
+++ /dev/null
-unportable
TYPEDEF: ulong Atom
-TYPEDEF: char* XPointer
+TYPEDEF: c-string XPointer
C-TYPE: Screen
TYPEDEF: void* GC
C-TYPE: Visual
! 4.3 - Properties and Atoms
-X-FUNCTION: Atom XInternAtom ( Display* display, char* atom_name, Bool only_if_exists ) ;
+X-FUNCTION: Atom XInternAtom ( Display* display, c-string atom_name, Bool only_if_exists ) ;
-X-FUNCTION: char* XGetAtomName ( Display* display, Atom atom ) ;
+X-FUNCTION: c-string XGetAtomName ( Display* display, Atom atom ) ;
! 4.4 - Obtaining and Changing Window Properties
-X-FUNCTION: int XGetWindowProperty ( Display* display, Window w, Atom property, long long_offset, long long_length, Bool delete, Atom req_type, Atom* actual_type_return, int* actual_format_return, ulong* nitems_return, ulong* bytes_after_return, char** prop_return ) ;
+X-FUNCTION: int XGetWindowProperty ( Display* display, Window w, Atom property, long long_offset, long long_length, Bool delete, Atom req_type, Atom* actual_type_return, int* actual_format_return, ulong* nitems_return, ulong* bytes_after_return, c-string* prop_return ) ;
X-FUNCTION: int XChangeProperty ( Display* display, Window w, Atom property, Atom type, int format, int mode, void* data, int nelements ) ;
X-FUNCTION: Pixmap XCreatePixmap ( Display* display, Drawable d, uint width, uint height, uint depth ) ;
X-FUNCTION: int XFreePixmap ( Display* display, Pixmap pixmap ) ;
+! 5.2 - Creating, Recoloring, and Freeing Cursors
+
+C-TYPE: XColor
+X-FUNCTION: Cursor XCreatePixmapCursor ( Display* display, Pixmap source, Pixmap mask, XColor* foreground_color, XColor* background_color, uint x, uint y ) ;
+X-FUNCTION: int XFreeCursor ( Display* display, Cursor cursor ) ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 6 - Color Management Functions
{ flags char }
{ pad char } ;
-X-FUNCTION: Status XLookupColor ( Display* display, Colormap colormap, char* color_name, XColor* exact_def_return, XColor* screen_def_return ) ;
+X-FUNCTION: Status XLookupColor ( Display* display, Colormap colormap, c-string color_name, XColor* exact_def_return, XColor* screen_def_return ) ;
X-FUNCTION: Status XAllocColor ( Display* display, Colormap colormap, XColor* screen_in_out ) ;
X-FUNCTION: Status XQueryColor ( Display* display, Colormap colormap, XColor* def_in_out ) ;
{ ascent int }
{ descent int } ;
-X-FUNCTION: Font XLoadFont ( Display* display, char* name ) ;
+X-FUNCTION: Font XLoadFont ( Display* display, c-string name ) ;
X-FUNCTION: XFontStruct* XQueryFont ( Display* display, XID font_ID ) ;
-X-FUNCTION: XFontStruct* XLoadQueryFont ( Display* display, char* name ) ;
+X-FUNCTION: XFontStruct* XLoadQueryFont ( Display* display, c-string name ) ;
-X-FUNCTION: int XTextWidth ( XFontStruct* font_struct, char* string, int count ) ;
+X-FUNCTION: int XTextWidth ( XFontStruct* font_struct, c-string string, int count ) ;
! 8.6 - Drawing Text
GC gc,
int x,
int y,
- char* string,
+ c-string string,
int length ) ;
! 8.7 - Transferring Images between Client and Server
{ height int }
{ xoffset int }
{ format int }
-{ data char* }
+{ data uchar* }
{ byte_order int }
{ bitmap_unit int }
{ bitmap_bit_order int }
{ send_event Bool }
{ display Display* }
{ window Window }
-{ pad int }
-{ pad int }
-{ pad int }
-{ pad int }
-{ pad int }
-{ pad int }
-{ pad int }
-{ pad int } ;
+{ pad int[8] } ;
UNION-STRUCT: XEvent
{ int int }
X-FUNCTION: Status XUngrabPointer ( Display* display, Time time ) ;
X-FUNCTION: Status XChangeActivePointerGrab ( Display* display, uint event_mask, Cursor cursor, Time time ) ;
X-FUNCTION: Status XGrabKey ( Display* display, int keycode, uint modifiers, Window grab_window, Bool owner_events, int pointer_mode, int keyboard_mode ) ;
+X-FUNCTION: int XGrabKeyboard ( Display* display, Window grab_window, Bool owner_events, int pointer_mode, int keyboard_mode, Time time ) ;
X-FUNCTION: Status XSetInputFocus ( Display* display, Window focus, int revert_to, Time time ) ;
X-FUNCTION: Status XGetInputFocus ( Display* display,
! 14.1 Client to Window Manager Communication
-X-FUNCTION: Status XFetchName ( Display* display, Window w, char** window_name_return ) ;
+X-FUNCTION: Status XFetchName ( Display* display, Window w, c-string* window_name_return ) ;
X-FUNCTION: Status XGetTransientForHint ( Display* display, Window w, Window* prop_window_return ) ;
! 14.1.1. Manipulating Top-Level Windows
{ colormap_size int }
{ bits_per_rgb int } ;
+! 16.9 Manipulating Bitmaps
+X-FUNCTION: Pixmap XCreateBitmapFromData (
+ Display* display,
+ Drawable d,
+ c-string data,
+ uint width,
+ uint height ) ;
+
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Appendix D - Compatibility Functions
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
X-FUNCTION: Status XSetStandardProperties (
Display* display,
Window w,
- char* window_name,
- char* icon_name,
+ c-string window_name,
+ c-string icon_name,
Pixmap icon_pixmap,
- char** argv,
+ c-string* argv,
int argc,
XSizeHints* hints ) ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
X-FUNCTION: void XFree ( void* data ) ;
-X-FUNCTION: int XStoreName ( Display* display, Window w, char* window_name ) ;
+X-FUNCTION: int XStoreName ( Display* display, Window w, c-string window_name ) ;
X-FUNCTION: void XSetWMNormalHints ( Display* display, Window w, XSizeHints* hints ) ;
X-FUNCTION: int XBell ( Display* display, int percent ) ;
X-FUNCTION: Bool XFilterEvent ( XEvent* event, Window w ) ;
-X-FUNCTION: XIM XOpenIM ( Display* dpy, void* rdb, char* res_name, char* res_class ) ;
+X-FUNCTION: XIM XOpenIM ( Display* dpy, void* rdb, c-string res_name, c-string res_class ) ;
X-FUNCTION: Status XCloseIM ( XIM im ) ;
-X-FUNCTION: XIC XCreateIC ( XIM im, char* key1, Window value1, char* key2, Window value2, char* key3, int value3, char* key4, char* value4, char* key5, char* value5, int key6 ) ;
+X-FUNCTION: XIC XCreateIC ( XIM im, c-string key1, Window value1, c-string key2, Window value2, c-string key3, int value3, c-string key4, c-string value4, c-string key5, c-string value5, int key6 ) ;
X-FUNCTION: void XDestroyIC ( XIC ic ) ;
X-FUNCTION: int XwcLookupString ( XIC ic, XKeyPressedEvent* event, ulong* buffer_return, int bytes_buffer, KeySym* keysym_return, Status* status_return ) ;
-X-FUNCTION: int Xutf8LookupString ( XIC ic, XKeyPressedEvent* event, char* buffer_return, int bytes_buffer, KeySym* keysym_return, Status* status_return ) ;
+X-FUNCTION: int Xutf8LookupString ( XIC ic, XKeyPressedEvent* event, c-string buffer_return, int bytes_buffer, KeySym* keysym_return, Status* status_return ) ;
! !!! category of setlocale
CONSTANT: LC_ALL 0
CONSTANT: LC_NUMERIC 4
CONSTANT: LC_TIME 5
-X-FUNCTION: char* setlocale ( int category, char* name ) ;
+X-FUNCTION: c-string setlocale ( int category, c-string name ) ;
X-FUNCTION: Bool XSupportsLocale ( ) ;
-X-FUNCTION: char* XSetLocaleModifiers ( char* modifier_list ) ;
+X-FUNCTION: c-string XSetLocaleModifiers ( c-string modifier_list ) ;
HELP: post-rpc
{ $values { "rpc" "an XML-RPC input tuple" } { "url" "a URL" }
- { "rpc" "an XML-RPC output tuple" } }
+ { "rpc'" "an XML-RPC output tuple" } }
{ $description "posts an XML-RPC document to the specified URL, receives the response and parses it as XML-RPC, returning the tuple" } ;
ARTICLE: { "xml-rpc" "intro" } "XML-RPC"
PRIVATE>
-: post-rpc ( rpc url -- rpc )
+: post-rpc ( rpc url -- rpc' )
! This needs to do something in the event of an error
rpc-post-request http-request nip string>xml receive-rpc ;
{ $see-also first-child-tag } ;
HELP: first-child-tag
-{ $values { "tag" "an XML tag or document" } { "tag" tag } }
+{ $values { "tag" "an XML tag or document" } { "child" tag } }
{ $description "Returns the first child of the given tag that is a tag." }
{ $see-also children-tags } ;
: children-tags ( tag -- sequence )
children>> [ tag? ] filter ;
-: first-child-tag ( tag -- tag )
+: first-child-tag ( tag -- child )
children>> [ tag? ] find nip ;
: tag-named? ( name elem -- ? )
ensure_program_installed git
ensure_program_installed wget curl
ensure_program_installed gcc
+ ensure_program_installed g++ cl
ensure_program_installed make gmake
ensure_program_installed md5sum md5
ensure_program_installed cut
USING: byte-arrays arrays help.syntax help.markup
alien.syntax compiler definitions math libc eval
debugger parser io io.backend system alien.accessors
-alien.libraries alien.c-types quotations ;
+alien.libraries alien.c-types quotations kernel
+sequences ;
IN: alien
+HELP: >c-ptr
+{ $values { "obj" object } { "c-ptr" c-ptr } }
+{ $contract "Outputs a pointer to the binary data of this object." } ;
+
+HELP: byte-length
+{ $values { "obj" object } { "n" "a non-negative integer" } }
+{ $contract "Outputs the number of bytes of binary data that will be output by " { $link >c-ptr } "." } ;
+
+HELP: element-size
+{ $values { "seq" sequence } { "n" "a non-negative integer" } }
+{ $contract "Outputs the number of bytes used for each element of the sequence." }
+{ $notes "If a sequence class implements " { $link element-size } " and " { $link >c-ptr } ", then instances of this sequence, as well as slices of this sequence, can be used as binary objects." } ;
+
+{ >c-ptr element-size byte-length } related-words
+
HELP: alien
{ $class-description "The class of alien pointers. See " { $link "syntax-aliens" } " for syntax and " { $link "c-data" } " for general information." } ;
{ $notes "Alien objects are invalidated between image saves and loads." } ;
HELP: c-ptr
-{ $class-description "Class of objects consisting of aliens, byte arrays and " { $link f } ". These objects can convert to pointer C types, which are all aliases of " { $snippet "void*" } "." } ;
+{ $class-description "Class of objects consisting of aliens, byte arrays and " { $link f } ". These objects all can be used as values of " { $link pointer } " C types." } ;
HELP: alien-invoke-error
{ $error-description "Thrown if the word calling " { $link alien-invoke } " was not compiled with the optimizing compiler. This may be a result of one of several failure conditions:"
}
"Anywhere that a " { $link alien } " instance is accepted, the " { $link f } " singleton may be passed in to denote a null pointer."
$nl
-"Usually alien objects do not have to created and dereferenced directly; instead declaring C function parameters and return values as having a pointer type such as " { $snippet "void*" } " takes care of the details."
+"Usually alien objects do not have to created and dereferenced directly; instead declaring C function parameters and return values as having a " { $link pointer } " type such as " { $snippet "void*" } " takes care of the details."
{ $subsections
"syntax-aliens"
"alien-expiry"
! Copyright (C) 2004, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs kernel math namespaces sequences system
-kernel.private byte-arrays arrays init ;
+kernel.private byte-arrays byte-vectors arrays init ;
IN: alien
PREDICATE: pinned-alien < alien underlying>> not ;
UNION: pinned-c-ptr pinned-alien POSTPONE: f ;
-GENERIC: >c-ptr ( obj -- c-ptr )
+GENERIC: element-size ( seq -- n ) flushable
+
+M: byte-array element-size drop 1 ; inline
+
+M: byte-vector element-size drop 1 ; inline
+
+M: slice element-size seq>> element-size ; inline
+
+M: f element-size drop 1 ; inline
+
+GENERIC: byte-length ( obj -- n ) flushable
+
+M: object byte-length [ length ] [ element-size ] bi * ; inline
+
+GENERIC: >c-ptr ( obj -- c-ptr ) flushable
M: c-ptr >c-ptr ; inline
+M: slice >c-ptr
+ [ [ from>> ] [ element-size ] bi * ] [ seq>> >c-ptr ] bi
+ <displaced-alien> ; inline
+
SLOT: underlying
M: object >c-ptr underlying>> ; inline
+: binary-object ( obj -- c-ptr n )
+ [ >c-ptr ] [ byte-length ] bi ; inline
+
GENERIC: expired? ( c-ptr -- ? ) flushable
M: alien expired? expired>> ;
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays sequences kernel kernel.private accessors math
alien.accessors byte-arrays io io.encodings io.encodings.utf8
M: tuple string>alien drop underlying>> ;
-HOOK: alien>native-string os ( alien -- string )
+HOOK: native-string-encoding os ( -- encoding ) foldable
-M: windows alien>native-string utf16n alien>string ;
+M: unix native-string-encoding utf8 ;
+M: windows native-string-encoding utf16n ;
-M: unix alien>native-string utf8 alien>string ;
+: alien>native-string ( alien -- string )
+ native-string-encoding alien>string ; inline
-HOOK: native-string>alien os ( string -- alien )
-
-M: windows native-string>alien utf16n string>alien ;
-
-M: unix native-string>alien utf8 string>alien ;
+: native-string>alien ( string -- alien )
+ native-string-encoding string>alien ; inline
: dll-path ( dll -- string )
path>> alien>native-string ;
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel kernel.private math math.private
sequences sequences.private ;
M: array nth-unsafe [ >fixnum ] dip array-nth ; inline
M: array set-nth-unsafe [ >fixnum ] dip set-array-nth ; inline
M: array resize resize-array ; inline
-
-: >array ( seq -- array ) { } clone-like ;
-
+M: array equal? over array? [ sequence= ] [ 2drop f ] if ;
M: object new-sequence drop 0 <array> ; inline
-
M: f new-sequence drop [ f ] [ 0 <array> ] if-zero ; inline
-M: array equal?
- over array? [ sequence= ] [ 2drop f ] if ;
-
INSTANCE: array sequence
+: >array ( seq -- array ) { } clone-like ;
: 1array ( x -- array ) 1 swap <array> ; inline
-
: 2array ( x y -- array ) { } 2sequence ; inline
-
: 3array ( x y z -- array ) { } 3sequence ; inline
-
: 4array ( w x y z -- array ) { } 4sequence ; inline
PREDICATE: pair < array length 2 number= ;
HELP: assoc-like
{ $values { "assoc" assoc } { "exemplar" assoc } { "newassoc" "a new assoc" } }
-{ $contract "Creates a new assoc having the same entries as "{ $snippet "assoc" } " and the same type as " { $snippet "exemplar" } "." } ;
+{ $contract "Creates a new assoc having the same entries as " { $snippet "assoc" } " and the same type as " { $snippet "exemplar" } "." } ;
HELP: assoc-empty?
{ $values { "assoc" assoc } { "?" "a boolean" } }
{ $side-effects "assoc" } ;
HELP: 2cache
-{ $values { "key1" "a key" } { "key2" "a key" } { "assoc" assoc } { "quot" { $quotation "( key -- value )" } } { "value" "a previously-retained or freshly-computed value" } }
+{ $values { "key1" "a key" } { "key2" "a key" } { "assoc" assoc } { "quot" { $quotation "( key1 key2 -- value )" } } { "value" "a previously-retained or freshly-computed value" } }
{ $description "If a single key composed of the input keys is present in the assoc, outputs the associated value, otherwise calls the quotation to produce a value and stores the keys/value pair into the assoc. Returns the value stored in the assoc. Returns a value either looked up or newly stored in the assoc." }
{ $side-effects "assoc" } ;
HELP: assoc-map-as
{ $values
- { "assoc" assoc } { "quot" quotation } { "exemplar" assoc }
+ { "assoc" assoc } { "quot" { $quotation "( key value -- newkey newvalue )" } } { "exemplar" assoc }
{ "newassoc" assoc } }
{ $description "Applies the quotation to each entry in the input assoc and collects the results in a new assoc of the stame type as the exemplar." }
{ $examples { $example "USING: prettyprint assocs hashtables math ;" " H{ { 1 2 } { 3 4 } } [ sq ] { } assoc-map-as ." "{ { 1 4 } { 3 16 } }" } } ;
{ "fread" "io.streams.c" "primitive_fread" (( n alien -- str/f )) }
{ "fseek" "io.streams.c" "primitive_fseek" (( alien offset whence -- )) }
{ "ftell" "io.streams.c" "primitive_ftell" (( alien -- n )) }
- { "fwrite" "io.streams.c" "primitive_fwrite" (( string alien -- )) }
+ { "fwrite" "io.streams.c" "primitive_fwrite" (( data length alien -- )) }
{ "(clone)" "kernel" "primitive_clone" (( obj -- newobj )) }
{ "<wrapper>" "kernel" "primitive_wrapper" (( obj -- wrapper )) }
{ "callstack" "kernel" "primitive_callstack" (( -- cs )) }
"SYMBOLS:"
"CONSTANT:"
"TUPLE:"
+ "final"
"SLOT:"
"T{"
"UNION:"
: flatten-class ( class -- assoc )
[ (flatten-class) ] H{ } make-assoc ;
+
+SYMBOL: +incomparable+
+
+: compare-classes ( class1 class2 -- ? )
+ {
+ { [ 2dup class<= ] [ t ] }
+ { [ 2dup classes-intersect? not ] [ f ] }
+ [ +incomparable+ ]
+ } cond 2nip ;
: create-class-in ( string -- word )
current-vocab create
+ dup set-word
dup save-class-location
- dup create-predicate-word dup set-word save-location ;
+ dup create-predicate-word save-location ;
: CREATE-CLASS ( -- word )
scan create-class-in ;
"tuple-inheritance-example"
"tuple-inheritance-anti-example"
}
+"Declaring a tuple class final prohibits other classes from subclassing it:"
+{ $subsections POSTPONE: final }
{ $see-also "call-next-method" "parametrized-constructors" "unions" "mixins" } ;
ARTICLE: "tuple-introspection" "Tuple introspection"
{ $description "Creates a new instance of " { $snippet "class" } " and fill in the slots from the stack, with the top-most stack element being stored in the right-most slot." }
{ $notes "The name " { $snippet "boa" } " is shorthand for “by order of arguments”, and “BOA constructor” is a pun on “boa constrictor”." }
{ $errors "Throws an error if the slot values do not match class declarations on slots (see" { $link "tuple-declarations" } ")." } ;
+
+HELP: bad-superclass
+{ $error-description "Thrown if an attempt is made to subclass a class that is not a tuple class, or a tuple class declared " { $link POSTPONE: final } "." } ;
] unit-test
[
- "IN: classes.tuple.tests TUPLE: bad-superclass < word ;" eval( -- )
+ "IN: classes.tuple.tests TUPLE: invalid-superclass < word ;" eval( -- )
] must-fail
! Dynamically changing inheritance hierarchy
[ ] [ "IN: classes.tuple.tests TUPLE: tuple-predicate-redefine-test ;" eval( -- ) ] unit-test
[ t ] [ \ tuple-predicate-redefine-test? predicate? ] unit-test
+
+! Final classes
+TUPLE: final-superclass ;
+TUPLE: final-subclass < final-superclass ;
+
+[ final-superclass ] [ final-subclass superclass ] unit-test
+
+! Making the superclass final should change the superclass of the subclass
+[ ] [ "IN: classes.tuple.tests TUPLE: final-superclass ; final" eval( -- ) ] unit-test
+
+[ tuple ] [ final-subclass superclass ] unit-test
+
+[ f ] [ \ final-subclass final-class? ] unit-test
+
+! Subclassing a final class should fail
+[ "IN: classes.tuple.tests TUPLE: final-subclass < final-superclass ;" eval( -- ) ]
+[ error>> bad-superclass? ] must-fail-with
+
+! Making a final class non-final should work
+[ ] [ "IN: classes.tuple.tests TUPLE: final-superclass ;" eval( -- ) ] unit-test
+
+[ ] [ "IN: classes.tuple.tests TUPLE: final-subclass < final-superclass ; final" eval( -- ) ] unit-test
+
+! Changing a superclass should not change the final status of a subclass
+[ ] [ "IN: classes.tuple.tests TUPLE: final-superclass x ;" eval( -- ) ] unit-test
+
+[ t ] [ \ final-subclass final-class? ] unit-test
] [ 2drop f ] if
] [ 2drop f ] if ; inline
+GENERIC: final-class? ( class -- ? )
+
+M: tuple-class final-class? "final" word-prop ;
+
+M: builtin-class final-class? tuple eq? not ;
+
+M: class final-class? drop t ;
+
<PRIVATE
: tuple-predicate-quot/1 ( class -- quot )
[ [ "slots" word-prop ] dip = ]
bi-curry* bi and ;
-GENERIC: valid-superclass? ( class -- ? )
-
-M: tuple-class valid-superclass? drop t ;
-
-M: builtin-class valid-superclass? tuple eq? ;
-
-M: class valid-superclass? drop f ;
-
: check-superclass ( superclass -- )
- dup valid-superclass? [ bad-superclass ] unless drop ;
+ dup final-class? [ bad-superclass ] when drop ;
GENERIC# (define-tuple-class) 2 ( class superclass slots -- )
read-only suffix
] map ;
+: reset-final ( class -- )
+ dup final-class? [
+ [ f "final" set-word-prop ]
+ [ changed-conditionally ]
+ bi
+ ] [ drop ] if ;
+
PRIVATE>
: define-tuple-class ( class superclass slots -- )
over prepare-slots
(define-tuple-class) ;
+GENERIC: make-final ( class -- )
+
+M: tuple-class make-final
+ [ dup class-usage keys ?metaclass-changed ]
+ [ t "final" set-word-prop ]
+ bi ;
+
M: word (define-tuple-class)
define-new-tuple-class ;
M: tuple-class (define-tuple-class)
+ pick reset-final
3dup tuple-class-unchanged?
[ 2drop ?define-symbol ] [ redefine-tuple-class ] if ;
] with each
] [
[ call-next-method ]
- [ { "layout" "slots" "boa-check" "prototype" } reset-props ]
+ [ { "layout" "slots" "boa-check" "prototype" "final" } reset-props ]
bi
] bi ;
{ $subsections "conditionals-boolean-equivalence" }
{ $see-also "booleans" "bitwise-arithmetic" both? either? } ;
-ARTICLE: "dataflow-combinators" "Data flow combinators"
-"Data flow combinators express common dataflow patterns such as performing a operation while preserving its inputs, applying multiple operations to a single value, applying a set of operations to a set of values, or applying a single operation to multiple values."
+ARTICLE: "dataflow-combinators" "Dataflow combinators"
+"Dataflow combinators express common dataflow patterns such as performing a operation while preserving its inputs, applying multiple operations to a single value, applying a set of operations to a set of values, or applying a single operation to multiple values."
{ $subsections
"dip-keep-combinators"
"cleave-combinators"
"spread-combinators"
"apply-combinators"
}
-"More intricate data flow can be constructed by composing " { $link "curried-dataflow" } "." ;
+"More intricate dataflow can be constructed by composing " { $link "curried-dataflow" } "." ;
ARTICLE: "combinators-quot" "Quotation construction utilities"
"Some words for creating quotations which can be useful for implementing method combinations and compiler transforms:"
hashtables sorting words sets math.order make ;
IN: combinators
+! Most of these combinators have compile-time expansions in
+! the optimizing compiler. See stack-checker.transforms and
+! compiler.tree.propagation.call-effect
+
<PRIVATE
: call-effect-unsafe ( quot effect -- ) drop call ;
PRIVATE>
-ERROR: wrong-values quot effect ;
+ERROR: wrong-values quot call-site ;
! We can't USE: effects here so we forward reference slots instead
SLOT: in
TUPLE: redefine-error def ;
: redefine-error ( definition -- )
- \ redefine-error boa
- { { "Continue" t } } throw-restarts drop ;
+ \ redefine-error boa throw-continue ;
<PRIVATE
throw-restarts
rethrow-restarts
}
+"A utility word using the above:"
+{ $subsections
+ throw-continue
+}
"The list of restarts from the most recently-thrown error is stored in a global variable:"
{ $subsections restarts }
-"To invoke restarts, see " { $link "debugger" } "." ;
+"To invoke restarts, use " { $link "debugger" } "." ;
ARTICLE: "errors-post-mortem" "Post-mortem error inspection"
"The most recently thrown error, together with the continuation at that point, are stored in a pair of global variables:"
{ $values { "error" object } { "restarts" "a sequence of " { $snippet "{ string object }" } " pairs" } { "restart" object } }
{ $description "Throws a restartable error using " { $link rethrow } ". Otherwise, this word is identical to " { $link throw-restarts } "." } ;
-{ throw rethrow throw-restarts rethrow-restarts } related-words
+{ throw rethrow throw-restarts rethrow-restarts throw-continue } related-words
+
+HELP: throw-continue
+{ $values { "error" object } }
+{ $description "Throws a resumable error. If the user elects to continue execution, this word returns normally." } ;
HELP: compute-restarts
{ $values { "error" object } { "seq" "a sequence" } }
: rethrow-restarts ( error restarts -- restart )
[ <condition> rethrow ] callcc1 2nip ;
+: throw-continue ( error -- )
+ { { "Continue" t } } throw-restarts drop ;
+
TUPLE: restart name obj continuation ;
C: <restart> restart
! Copyright (C) 2006, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.parser math.order namespaces make sequences strings
-words assocs combinators accessors arrays quotations ;
+USING: kernel math math.parser math.order namespaces make
+sequences strings words assocs combinators accessors arrays
+quotations ;
IN: effects
TUPLE: effect
GENERIC: stack-effect ( word -- effect/f )
-M: word stack-effect "declared-effect" word-prop ;
+M: word stack-effect
+ [ "declared-effect" word-prop ]
+ [ parent-word dup [ stack-effect ] when ] bi or ;
M: deferred stack-effect call-next-method (( -- * )) or ;
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: lexer sets sequences kernel splitting effects
-combinators arrays vocabs.parser classes ;
+combinators arrays vocabs.parser classes parser ;
IN: effects.parser
DEFER: parse-effect
":" ?tail [
scan {
{ [ dup "(" = ] [ drop ")" parse-effect ] }
- { [ dup search class? ] [ search ] }
{ [ dup f = ] [ ")" unexpected-eof ] }
- [ bad-effect ]
+ [ parse-word dup class? [ bad-effect ] unless ]
} cond 2array
] when
] if
: parse-call( ( accum word -- accum )
[ ")" parse-effect ] dip 2array append! ;
+
+: (:) ( -- word def effect )
+ CREATE-WORD
+ complete-effect
+ parse-definition swap ;
HELP: (call-next-method)
{ $values { "method" method } }
{ $description "Low-level word implementing " { $link POSTPONE: call-next-method } "." }
-{ $notes "In most cases, " { $link POSTPONE: call-next-method } " should be used instead." } ;
+{ $notes
+ "The " { $link POSTPONE: call-next-method } " word parses into this word. The following are equivalent:"
+ { $code
+ "M: class generic call-next-method ;"
+ "M: class generic M\\ class generic (call-next-method) ;"
+ }
+} ;
HELP: no-next-method
{ $error-description "Thrown by " { $link POSTPONE: call-next-method } " if the current method is already the least specific method." }
] unit-test
[ 10 forget-test ] [ no-method? ] must-fail-with
+
+! Declarations on methods
+GENERIC: flushable-generic ( a -- b ) flushable
+M: integer flushable-generic ;
+
+[ t ] [ \ flushable-generic flushable? ] unit-test
+[ t ] [ M\ integer flushable-generic flushable? ] unit-test
+
+GENERIC: non-flushable-generic ( a -- b )
+M: integer non-flushable-generic ; flushable
+
+[ f ] [ \ non-flushable-generic flushable? ] unit-test
+[ t ] [ M\ integer non-flushable-generic flushable? ] unit-test
-! Copyright (C) 2006, 2009 Slava Pestov.
+! Copyright (C) 2006, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors words kernel sequences namespaces make assocs
hashtables definitions kernel.private classes classes.private
: method-word-name ( class generic -- string )
[ name>> ] bi@ "=>" glue ;
-M: method flushable?
- "method-generic" word-prop flushable? ;
-
-M: method stack-effect
- "method-generic" word-prop stack-effect ;
+M: method parent-word
+ "method-generic" word-prop ;
M: method crossref?
"forgotten" word-prop not ;
tri
] { } make ;
-M: generic forget*
- [ subwords forget-all ] [ call-next-method ] bi ;
-
M: class forget-methods
[ implementors ] [ [ swap method ] curry ] bi map forget-all ;
-USING: arrays debugger.threads destructors io io.directories
-io.encodings.ascii io.encodings.binary io.encodings.string
-io.encodings.8-bit.latin1 io.files io.files.private
-io.files.temp io.files.unique kernel make math sequences system
-threads tools.test generic.single ;
+USING: alien alien.c-types arrays classes.struct
+debugger.threads destructors generic.single io io.directories
+io.encodings.8-bit.latin1 io.encodings.ascii
+io.encodings.binary io.encodings.string io.files
+io.files.private io.files.temp io.files.unique kernel make math
+sequences specialized-arrays system threads tools.test ;
+SPECIALIZED-ARRAY: int
IN: io.files.tests
[ ] [ "append-test" temp-file dup exists? [ delete-file ] [ drop ] if ] unit-test
] with-file-reader
] unit-test
+! Writing specialized arrays to binary streams should work
+[ ] [
+ "test.txt" temp-file binary [
+ int-array{ 1 2 3 } write
+ ] with-file-writer
+] unit-test
+
+[ int-array{ 1 2 3 } ] [
+ "test.txt" temp-file binary [
+ 3 4 * read
+ ] with-file-reader
+ byte-array>int-array
+] unit-test
+
+[ ] [
+ BV{ 0 1 2 } "test.txt" temp-file binary set-file-contents
+] unit-test
+
+[ t ] [
+ "test.txt" temp-file binary file-contents
+ B{ 0 1 2 } =
+] unit-test
+
+STRUCT: pt { x uint } { y uint } ;
+SPECIALIZED-ARRAY: pt
+
+CONSTANT: pt-array-1
+ pt-array{ S{ pt f 1 1 } S{ pt f 2 2 } S{ pt f 3 3 } }
+
+[ ] [
+ pt-array-1
+ "test.txt" temp-file binary set-file-contents
+] unit-test
+
+[ t ] [
+ "test.txt" temp-file binary file-contents
+ pt-array-1 >c-ptr sequence=
+] unit-test
+
+! Slices should support >c-ptr and byte-length
+
+[ ] [
+ pt-array-1 rest-slice
+ "test.txt" temp-file binary set-file-contents
+] unit-test
+
+[ t ] [
+ "test.txt" temp-file binary file-contents
+ byte-array>pt-array
+ pt-array-1 rest-slice sequence=
+] unit-test
+
+! Writing strings to binary streams should fail
+[
+ "test.txt" temp-file binary [
+ "OMGFAIL" write
+ ] with-file-writer
+] must-fail
+
! Test EOF behavior
[ 10 ] [
image binary [
] with-file-reader
] unit-test
-USE: debugger.threads
-
+! Make sure that writing to a closed stream from another thread doesn't crash
[ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
[ ] [ "test-quux.txt" temp-file delete-file ] unit-test
USING: help.markup help.syntax quotations hashtables kernel
-classes strings continuations destructors math byte-arrays ;
+classes strings continuations destructors math byte-arrays
+alien ;
IN: io
+ARTICLE: "stream-types" "Binary and text streams"
+"A word which outputs the stream element type:"
+{ $subsections stream-element-type }
+"Stream element types:"
+{ $subsections +byte+ +character+ }
+"The stream element type is the data type read and written by " { $link stream-read1 } " and " { $link stream-write1 } "."
+$nl
+"Binary streams have an element type of " { $link +byte+ } ". Elements are integers in the range " { $snippet "[0,255]" } ", representing bytes. Reading a sequence of elements produces a " { $link byte-array } ". Any object implementing the " { $link >c-ptr } " and " { $link byte-length } " generic words can be written to a binary stream."
+$nl
+"Character streams have an element tye of " { $link +character+ } ". Elements are non-negative integers, representing Unicode code points. Only instances of the " { $link string } " class can be read or written on a character stream."
+$nl
+"Most external streams are binary streams, and can be wrapped in string streams once a suitable encoding has been provided; see " { $link "io.encodings" } "." ;
+
HELP: +byte+
{ $description "A stream element type. See " { $link stream-element-type } " for explanation." } ;
HELP: stream-element-type
{ $values { "stream" "a stream" } { "type" { $link +byte+ } " or " { $link +character+ } } }
-{ $description
- "Outputs one of the following two values:"
- { $list
- { { $link +byte+ } " - indicates that stream elements are integers in the range " { $snippet "[0,255]" } "; they represent bytes. Reading a sequence of elements produces a " { $link byte-array } "." }
- { { $link +character+ } " - indicates that stream elements are non-negative integers, representing Unicode code points. Reading a sequence of elements produces a " { $link string } "." }
- }
- "Most external streams are binary streams, and can be wrapped in string streams once a suitable encoding has been provided; see " { $link "io.encodings" } "."
-
-} ;
+{ $contract "Outputs one of " { $link +byte+ } " or " { $link +character+ } "." } ;
HELP: stream-readln
{ $values { "stream" "an input stream" } { "str/f" "a string or " { $link f } } }
$io-error ;
HELP: stream-write
-{ $values { "seq" "a byte array or string" } { "stream" "an output stream" } }
-{ $contract "Writes a sequence of elements to the stream. If the stream does buffering, output may not be performed immediately; use " { $link stream-flush } " to force output." }
+{ $values { "data" "binary data or a string" } { "stream" "an output stream" } }
+{ $contract "Writes a piece of data to the stream. If the stream performs buffering, output may not be performed immediately; use " { $link stream-flush } " to force output." }
{ $notes "Most code only works on one stream at a time and should instead use " { $link write } "; see " { $link "stdio" } "." }
$io-error ;
"Stream protocol words are rarely called directly, since code which only works with one stream at a time should be written to use " { $link "stdio" } " instead, wrapping I/O operations such as " { $link read } " and " { $link write } " in " { $link with-input-stream } " and " { $link with-output-stream } "."
$nl
"All streams must implement the " { $link dispose } " word in addition to the stream protocol."
-$nl
-"The following word is required for all input and output streams:"
-{ $subsections stream-element-type }
+{ $subsections "stream-types" }
"These words are required for binary and string input streams:"
{ $subsections
stream-read1
GENERIC: stream-readln ( stream -- str/f )
GENERIC: stream-write1 ( elt stream -- )
-GENERIC: stream-write ( seq stream -- )
+GENERIC: stream-write ( data stream -- )
GENERIC: stream-flush ( stream -- )
GENERIC: stream-nl ( stream -- )
{ $values { "path" "a pathname string" } { "path'" "a new pathname string" } }
{ $description "Prepends the " { $link current-directory } " to the pathname, resolves a " { $snippet "resource:" } " or " { $snippet "vocab:" } " prefix, if present (see " { $link "io.pathnames.special" } "). Also converts the path into a UNC path on Windows." }
{ $notes "High-level words, such as " { $link <file-reader> } " and " { $link delete-file } " call this word for you. It only needs to be called directly when passing pathnames to C functions or external processes. This is because Factor does not use the operating system's notion of a current directory, and instead maintains its own dynamically-scoped " { $link current-directory } " variable." }
-{ $notes "On Windows NT platforms, this word does prepends the Unicode path prefix." }
+{ $notes "On Windows NT platforms, this word prepends the Unicode path prefix." }
{ $examples
"For example, if you create a file named " { $snippet "data.txt" } " in the current directory, and wish to pass it to a process, you must normalize it:"
{ $code
USING: tools.test io.streams.byte-array io.encodings.binary
-io.encodings.utf8 io kernel arrays strings namespaces math ;
+io.encodings.utf8 io kernel arrays strings namespaces math
+specialized-arrays alien.c-types ;
+SPECIALIZED-ARRAY: int
+IN: io.streams.byte-array.tests
[ B{ } ] [ B{ } binary [ contents ] with-byte-reader ] unit-test
[ B{ 1 2 3 } ] [ binary [ B{ 1 2 3 } write ] with-byte-writer ] unit-test
+[ B{ 1 2 3 4 5 6 } ] [ binary [ B{ 1 2 3 } write B{ 4 5 6 } write ] with-byte-writer ] unit-test
[ B{ 1 2 3 } ] [ { 1 2 3 } binary [ 3 read ] with-byte-reader ] unit-test
[ B{ BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 BIN: 11101111 BIN: 10000000 BIN: 10111111 BIN: 11011111 BIN: 10000000 CHAR: x } ]
[ B{ 123 } ] [
binary [ 123 >bignum write1 ] with-byte-writer
] unit-test
+
+! Writing specialized arrays to byte writers
+[ int-array{ 1 2 3 } ] [
+ binary [ int-array{ 1 2 3 } write ] with-byte-writer
+ byte-array>int-array
+] unit-test
USING: help.markup help.syntax io io.files threads
-strings byte-arrays io.streams.plain ;
+strings byte-arrays io.streams.plain alien math ;
IN: io.streams.c
ARTICLE: "io.streams.c" "ANSI C streams"
{ $errors "Throws an error if the file could not be opened." }
{ $notes "User code should call " { $link <file-reader> } " or " { $link <file-writer> } " to get a high level stream." } ;
-HELP: fwrite ( string alien -- )
-{ $values { "string" "a string" } { "alien" "a C FILE* handle" } }
-{ $description "Writes a string of text to a C FILE* handle." }
+HELP: fwrite
+{ $values { "data" c-ptr } { "length" integer } { "alien" "a C FILE* handle" } }
+{ $description "Writes some bytes to a C FILE* handle." }
{ $errors "Throws an error if the output operation failed." } ;
HELP: fflush ( alien -- )
{ $errors "Throws an error if the input operation failed." } ;
HELP: fread ( n alien -- str/f )
-{ $values { "n" "a positive integer" } { "alien" "a C FILE* handle" } { "str/f" "a string or " { $link f } } }
+{ $values { "n" "a positive integer" } { "alien" "a C FILE* handle" } { "str/f" { $maybe string } } }
{ $description "Reads a sequence of characters from a C FILE* handle, and outputs " { $link f } " on end of file." }
{ $errors "Throws an error if the input operation failed." } ;
USING: tools.test io.files io.files.temp io io.streams.c
-io.encodings.ascii strings destructors kernel ;
+io.encodings.ascii strings destructors kernel specialized-arrays
+alien.c-types math ;
+SPECIALIZED-ARRAY: int
IN: io.streams.c.tests
[ "hello world" ] [
3 over stream-read drop
[ stream-tell ] [ dispose ] bi
] unit-test
+
+! Writing specialized arrays to binary streams
+[ ] [
+ "test.txt" temp-file "wb" fopen <c-writer> [
+ int-array{ 1 2 3 } write
+ ] with-output-stream
+] unit-test
+
+[ int-array{ 1 2 3 } ] [
+ "test.txt" temp-file "rb" fopen <c-reader> [
+ 3 4 * read
+ ] with-input-stream
+ byte-array>int-array
+] unit-test
+
+! Writing strings to binary streams should fail
+[
+ "test.txt" temp-file "wb" fopen <c-writer> [
+ "OMGFAIL" write
+ ] with-output-stream
+] must-fail
-! Copyright (C) 2004, 2009 Slava Pestov.
+! Copyright (C) 2004, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel kernel.private namespaces make io io.encodings sequences
-math generic threads.private classes io.backend io.files
-io.encodings.utf8 alien.strings continuations destructors byte-arrays
-accessors combinators ;
+USING: alien alien.strings kernel kernel.private namespaces make
+io io.encodings sequences math generic threads.private classes
+io.backend io.files io.encodings.utf8 continuations destructors
+byte-arrays accessors combinators ;
IN: io.streams.c
TUPLE: c-stream < disposable handle ;
M: c-stream stream-tell handle>> ftell ;
M: c-stream stream-seek
- handle>> swap {
- { seek-absolute [ 0 ] }
- { seek-relative [ 1 ] }
- { seek-end [ 2 ] }
- [ bad-seek-type ]
- } case fseek ;
+ [
+ {
+ { seek-absolute [ 0 ] }
+ { seek-relative [ 1 ] }
+ { seek-end [ 2 ] }
+ [ bad-seek-type ]
+ } case
+ ] [ handle>> ] bi* fseek ;
TUPLE: c-writer < c-stream ;
M: c-writer stream-write1 dup check-disposed handle>> fputc ;
-M: c-writer stream-write dup check-disposed handle>> fwrite ;
+M: c-writer stream-write
+ dup check-disposed
+ [ [ >c-ptr ] [ byte-length ] bi ] [ handle>> ] bi* fwrite ;
M: c-writer stream-flush dup check-disposed handle>> fflush ;
#! print stuff from contexts where the I/O system would
#! otherwise not work (tools.deploy.shaker, the I/O
#! multiplexer thread).
- "\n" append >byte-array
+ "\n" append >byte-array dup length
stdout-handle fwrite
stdout-handle fflush ;
{ $notes "This operation is efficient and does not copy the quotation." } ;
HELP: with
-{ $values { "param" object } { "obj" object } { "quot" { $quotation "( param elt -- ... )" } } { "obj" object } { "curry" curry } }
+{ $values { "param" object } { "obj" object } { "quot" { $quotation "( param elt -- ... )" } } { "curry" curry } }
{ $description "Partial application on the left. The following two lines are equivalent:"
{ $code "swap [ swap A ] curry B" }
{ $code "[ A ] with B" }
HELP: make
{ $values { "quot" quotation } { "exemplar" sequence } { "seq" "a new sequence" } }
-{ $description "Calls the quotation in a new " { $emphasis "dynamic scope" } ". The quotation and any words it calls can execute the " { $link , } " and " { $link % } " words to accumulate elements. When the quotation returns, all accumulated elements are collected into a sequence with the same type as " { $snippet "exemplar" } "." }
+{ $description "Calls the quotation in a new dynamic scope with the " { $link building } " variable bound to a new resizable mutable sequence. The quotation and any words it calls can execute the " { $link , } " and " { $link % } " words to accumulate elements. When the quotation returns, all accumulated elements are collected into a sequence with the same type as " { $snippet "exemplar" } "." }
{ $examples { $example "USING: make prettyprint ;" "[ 1 , 2 , 3 , ] { } make ." "{ 1 2 3 }" } } ;
HELP: ,
HELP: rem
{ $values { "x" rational } { "y" rational } { "z" rational } }
{ $description
- "Computes the remainder of dividing " { $snippet "x" } " by " { $snippet "y" } ", with the remainder always positive."
+ "Computes the remainder of dividing " { $snippet "x" } " by " { $snippet "y" } ", with the remainder always positive or zero."
{ $list
"Given fixnums, always yields a fixnum."
"Given bignums, always yields a bignum."
HELP: real-part
{ $values { "z" number } { "x" real } }
{ $description "Outputs the real part of a complex number. This acts as the identity on real numbers." }
-{ $examples { $example "USING: math prettyprint ; C{ 1 2 } real-part ." "1" } } ;
+{ $examples { $example "USING: math prettyprint ;" "C{ 1 2 } real-part ." "1" } } ;
HELP: imaginary-part
{ $values { "z" number } { "y" real } }
{ $description "Outputs the imaginary part of a complex number. This outputs zero for real numbers." }
{ $examples
- { $example "USING: math prettyprint ; C{ 1 2 } imaginary-part ." "2" }
- { $example "USING: math prettyprint ; 3 imaginary-part ." "0" }
+ { $example "USING: math prettyprint ;" "C{ 1 2 } imaginary-part ." "2" }
+ { $example "USING: math prettyprint ;" "3 imaginary-part ." "0" }
} ;
HELP: real
{ $errors "Throws a " { $link lexer-error } " if the input is malformed." } ;
HELP: parse-base
-{ $values { "parsed" integer } { "base" "an integer between 2 and 36" } { "parsed" integer } }
+{ $values { "parsed" integer } { "base" "an integer between 2 and 36" } }
{ $description "Reads an integer in a specific numerical base from the parser input." }
$parsing-note ;
] unit-test
[ t ] [
- "foo?" "parser.tests" lookup word eq?
+ "foo" "parser.tests" lookup word eq?
] unit-test
[ ] [
-! Copyright (C) 2005, 2009 Slava Pestov.
+! Copyright (C) 2005, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays definitions generic assocs kernel math namespaces
sequences strings vectors words words.symbol quotations io
combinators sorting splitting math.parser effects continuations
io.files vocabs io.encodings.utf8 source-files classes
hashtables compiler.units accessors sets lexer vocabs.parser
-effects.parser slots parser.notes ;
+ slots parser.notes ;
IN: parser
: location ( -- loc )
[ "Added \"" "\" vocabulary to search path" surround note. ] bi
] [ create-in ] if ;
+: ignore-forwards ( seq -- seq' )
+ [ forward-reference? not ] filter ;
+
+: private? ( word -- ? ) vocabulary>> ".private" tail? ;
+
+: ignore-privates ( seq -- seq' )
+ dup [ private? ] all? [ [ private? not ] filter ] unless ;
+
: no-word ( name -- newword )
- dup words-named [ forward-reference? not ] filter
- dup length 1 = auto-use? get and
- [ nip first no-word-restarted ]
- [ <no-word-error> throw-restarts no-word-restarted ]
+ dup words-named ignore-forwards
+ dup ignore-privates dup length 1 = auto-use? get and
+ [ 2nip first no-word-restarted ]
+ [ drop <no-word-error> throw-restarts no-word-restarted ]
if ;
: parse-word ( string -- word/number )
: parse-definition ( -- quot )
\ ; parse-until >quotation ;
-: (:) ( -- word def effect )
- CREATE-WORD
- complete-effect
- parse-definition swap ;
-
ERROR: bad-number ;
: scan-base ( base -- n )
HELP: reduce-index
{ $values
- { "seq" sequence } { "identity" object } { "quot" quotation } }
+ { "seq" sequence } { "identity" object } { "quot" { $quotation "( prev elt index -- result )" } } }
{ $description "Combines successive elements of the sequence and their indices binary operations, and outputs the final result. On the first iteration, the three inputs to the quotation are " { $snippet "identity" } ", the first element of the sequence, and its index, 0. On successive iterations, the first input is the result of the previous iteration, the second input is the corresponding element of the sequence, and the third is its index." }
{ $examples { $example "USING: sequences prettyprint math ;"
"{ 10 50 90 } 0 [ + + ] reduce-index ."
} ;
HELP: accumulate!
-{ $values { "seq" sequence } { "identity" object } { "quot" { $quotation "( prev elt -- next )" } } { "final" "the final result" } { "seq" sequence } }
+{ $values { "seq" sequence } { "identity" object } { "quot" { $quotation "( prev elt -- next )" } } { "final" "the final result" } }
{ $description "Combines successive elements of the sequence using a binary operation, and outputs the original sequence of intermediate results, together with the final result."
$nl
"The first element of the new sequence is " { $snippet "identity" } ". Then, on the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the old sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the old sequence."
HELP: each-index
{ $values
- { "seq" sequence } { "quot" quotation } }
+ { "seq" sequence } { "quot" { $quotation "( elt index -- )" } } }
{ $description "Calls the quotation with the element of the sequence and its index on the stack, with the index on the top of the stack." }
-{ $examples { $example "USING: sequences prettyprint math ;"
-"{ 10 20 30 } [ + . ] each-index"
-"10\n21\n32"
+{ $examples { $example "USING: arrays sequences prettyprint ;"
+"{ 10 20 30 } [ 2array . ] each-index"
+"{ 10 0 }\n{ 20 1 }\n{ 30 2 }"
} } ;
HELP: map-index
{ $values
- { "seq" sequence } { "quot" quotation } { "newseq" sequence } }
+ { "seq" sequence } { "quot" { $quotation "( elt index -- result )" } } { "newseq" sequence } }
{ $description "Calls the quotation with the element of the sequence and its index on the stack, with the index on the top of the stack. Collects the outputs of the quotation and outputs them in a sequence of the same type as the input sequence." }
-{ $examples { $example "USING: sequences prettyprint math ;"
-"{ 10 20 30 } [ + ] map-index ."
-"{ 10 21 32 }"
+{ $examples { $example "USING: arrays sequences prettyprint ;"
+"{ 10 20 30 } [ 2array ] map-index ."
+"{ { 10 0 } { 20 1 } { 30 2 } }"
} } ;
HELP: change-nth
{ $side-effects "seq" } ;
HELP: map!
-{ $values { "seq" "a mutable sequence" } { "quot" { $quotation "( old -- new )" } } { "seq" "a mutable sequence" } }
+{ $values { "seq" "a mutable sequence" } { "quot" { $quotation "( old -- new )" } } }
{ $description "Applies the quotation to each element yielding a new element, storing the new elements back in the original sequence. Returns the original sequence." }
{ $errors "Throws an error if the sequence is immutable, or the sequence cannot hold elements of the type output by " { $snippet "quot" } "." }
{ $side-effects "seq" } ;
{ $description "Applies the quotation to each element in turn, and outputs a new sequence of the same type as " { $snippet "exemplar" } " containing the elements of the original sequence for which the quotation output a true value." } ;
HELP: filter!
-{ $values { "seq" "a resizable mutable sequence" } { "quot" { $quotation "( elt -- ? )" } } { "seq" "a resizable mutable sequence" } }
+{ $values { "seq" "a resizable mutable sequence" } { "quot" { $quotation "( elt -- ? )" } } }
{ $description "Applies the quotation to each element in turn, and removes elements for which the quotation outputs a false value." }
{ $side-effects "seq" } ;
{ $side-effects "seq" } ;
HELP: remove!
-{ $values { "elt" object } { "seq" "a resizable mutable sequence" } { "elt" object } }
+{ $values { "elt" object } { "seq" "a resizable mutable sequence" } }
{ $description "Removes all elements equal to " { $snippet "elt" } " from " { $snippet "seq" } " and returns " { $snippet "seq" } "." }
{ $notes "This word uses equality comparison (" { $link = } ")." }
{ $side-effects "seq" } ;
HELP: remove-eq!
-{ $values { "elt" object } { "seq" "a resizable mutable sequence" } { "seq" "a resizable mutable sequence" } }
+{ $values { "elt" object } { "seq" "a resizable mutable sequence" } }
{ $description "Outputs a new sequence containing all elements of the input sequence except the given element." }
{ $notes "This word uses identity comparison (" { $link eq? } ")." }
{ $side-effects "seq" } ;
HELP: remove-nth!
-{ $values { "n" "a non-negative integer" } { "seq" "a resizable mutable sequence" } { "seq" "a resizable mutable sequence" } }
+{ $values { "n" "a non-negative integer" } { "seq" "a resizable mutable sequence" } }
{ $description "Removes the " { $snippet "n" } "th element from the sequence, shifting all other elements down and reducing its length by one." }
{ $side-effects "seq" } ;
} ;
HELP: suffix!
-{ $values { "seq" sequence } { "elt" object } { "seq" sequence } }
+{ $values { "seq" sequence } { "elt" object } }
{ $description "Modifiers a sequence in-place by adding " { $snippet "elt" } " to the end of " { $snippet "seq" } ". Outputs " { $snippet "seq" } "." }
{ $errors "Throws an error if the type of " { $snippet "elt" } " is not permitted in sequences of the same class as " { $snippet "seq" } "." }
{ $examples
} ;
HELP: append!
-{ $values { "seq1" sequence } { "seq2" sequence } { "seq1" sequence } }
+{ $values { "seq1" sequence } { "seq2" sequence } }
{ $description "Modifiers " { $snippet "seq1" } " in-place by adding the elements from " { $snippet "seq2" } " to the end and outputs " { $snippet "seq1" } "." }
{ $examples
{ $example "USING: prettyprint sequences ;" "V{ 1 2 3 } { 4 5 6 } append! ." "V{ 1 2 3 4 5 6 }" }
HELP: selector
{ $values
- { "quot" "a predicate quotation" }
- { "quot" quotation } { "accum" vector } }
+ { "quot" { $quotation "( elt -- ? )" } }
+ { "selector" { $quotation "( elt -- )" } } { "accum" vector } }
{ $description "Creates a new vector to accumulate the values which return true for a predicate. Returns a new quotation which accepts an object to be tested and stored in the collector if the test yields true. The collector is left on the stack for convenience." }
{ $example "! Find all the even numbers:" "USING: prettyprint sequences math kernel ;"
"10 iota [ even? ] selector [ each ] dip ."
HELP: replicate-as
{ $values
- { "len" integer } { "quot" quotation } { "exemplar" sequence }
+ { "len" integer } { "quot" { $quotation "( -- elt )" } } { "exemplar" sequence }
{ "newseq" sequence } }
{ $description "Calls the quotation " { $snippet "len" } " times, collecting results into a new sequence of the same type as the exemplar sequence." }
{ $examples
HELP: 2map-reduce
{ $values
- { "seq1" sequence } { "seq2" sequence } { "map-quot" quotation } { "reduce-quot" quotation }
+ { "seq1" sequence } { "seq2" sequence } { "map-quot" { $quotation "( elt1 elt2 -- intermediate )" } } { "reduce-quot" { $quotation "( prev intermediate -- result )" } }
{ "result" object } }
{ $description "Calls " { $snippet "map-quot" } " on each pair of elements from " { $snippet "seq1" } " and " { $snippet "seq2" } " and combines the results using " { $snippet "reduce-quot" } " in the same manner as " { $link reduce } ", except that there is no identity element, and the sequence must have a length of at least 1." }
{ $errors "Throws an error if the sequence is empty." }
HELP: 2selector
{ $values
{ "quot" quotation }
- { "quot" quotation } { "accum1" vector } { "accum2" vector } }
+ { "selector" quotation } { "accum1" vector } { "accum2" vector } }
{ $description "Creates two new vectors to accumultate values based on a predicate. The first vector accumulates values for which the predicate yields true; the second for false." } ;
HELP: 2reverse-each
HELP: binary-reduce
{ $values
- { "seq" sequence } { "start" integer } { "quot" quotation }
+ { "seq" sequence } { "start" integer } { "quot" { $quotation "( elt1 elt2 -- newelt )" } }
{ "value" object } }
{ $description "Like " { $link reduce } ", but splits the sequence in half recursively until each sequence is small enough, and calls the quotation on these smaller sequences. If the quotation computes values that depend on the size of their input, such as bignum arithmetic, then this algorithm can be more efficient than using " { $link reduce } "." }
{ $examples "Computing factorial:"
HELP: follow
{ $values
- { "obj" object } { "quot" quotation }
+ { "obj" object } { "quot" { $quotation "( prev -- result/f )" } }
{ "seq" sequence } }
{ $description "Outputs a sequence containing the input object and all of the objects generated by successively feeding the result of the quotation called on the input object to the quotation recursuively. Objects yielded by the quotation are added to the output sequence until the quotation yields " { $link f } ", at which point the recursion terminates." }
{ $examples "Get random numbers until zero is reached:"
HELP: short
{ $values
- { "seq" sequence } { "n" integer }
- { "seq" sequence } { "n'" integer } }
+ { "seq" sequence } { "n" integer } { "n'" integer } }
{ $description "Returns the input sequence and its length or " { $snippet "n" } ", whichever is less." }
{ $examples { $example "USING: sequences kernel prettyprint ;"
"\"abcd\" 3 short [ . ] bi@"
}
} ;
+HELP: cartesian-each
+{ $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation "( elt1 elt2 -- )" } } }
+{ $description "Applies the quotation to every possible pairing of elements from the two sequences." } ;
+
+HELP: cartesian-map
+{ $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation "( elt1 elt2 -- result )" } } { "newseq" "a new sequence of sequences" } }
+{ $description "Applies the quotation to every possible pairing of elements from the two sequences, collecting results into a new sequence of sequences." } ;
+
+HELP: cartesian-product
+{ $values { "seq1" sequence } { "seq2" sequence } { "newseq" "a new sequence of sequences of pairs" } }
+{ $description "Outputs a sequence of all possible pairings of elements from the two sequences." }
+{ $examples
+ { $example
+ "USING: prettyprint sequences ;"
+ "{ 1 2 } { 3 4 } cartesian-product ."
+ "{ { { 1 3 } { 1 4 } } { { 2 3 } { 2 4 } } }"
+ }
+} ;
+
ARTICLE: "sequences-unsafe" "Unsafe sequence operations"
"The " { $link nth-unsafe } " and " { $link set-nth-unsafe } " sequence protocol bypasses bounds checks for increased performance."
$nl
ARTICLE: "sequences-integers" "Counted loops"
"A virtual sequence is defined for iterating over integers from zero."
{ $subsection iota }
-"For example, calling " { $link iota } " on the integer 3 produces a sequence containing the elements 0, 1, and 2. This is very useful for performing counted loops."
-$nl
-"This means the " { $link each } " combinator, given an integer, simply calls a quotation that number of times, pushing a counter on each iteration that ranges from 0 up to that integer:"
+"For example, calling " { $link iota } " on the integer 3 produces a sequence containing the elements 0, 1, and 2. This is very useful for performing counted loops using words such as " { $link each } ":"
{ $example "3 iota [ . ] each" "0\n1\n2" }
"A common idiom is to iterate over a sequence, while also maintaining a loop counter. This can be done using " { $link each-index } ", " { $link map-index } " and " { $link reduce-index } "."
$nl
}
"The second reason is much weaker than the first one. In particular, many combinators (see " { $link map } ", " { $link produce } " and " { $link "namespaces-make" } ") as well as more advanced data structures (such as " { $vocab-link "persistent.vectors" } ") alleviate the need for explicit use of side effects." ;
-ARTICLE: "sequences-destructive" "Destructive operations"
-"Many operations have constructive and destructive variants:"
+ARTICLE: "sequences-destructive" "Destructive sequence operations"
+"Many operations have destructive variants that side effect an input sequence, instead of creating a new sequence:"
{ $table
{ "Constructive" "Destructive" }
{ { $link suffix } { $link suffix! } }
delete-all
filter!
}
+"Adding elements:"
+{ $subsections
+ suffix!
+ append!
+}
"Other destructive words:"
{ $subsections
reverse!
- append!
move
exchange
copy
2selector
} ;
+ARTICLE: "sequences-cartesian" "Cartesian product operations"
+"The cartesian product of two sequences is a sequence of all pairs where the first element of each pair is from the first sequence, and the second element of each pair is from the second sequence. The number of elements in the cartesian product is the product of the lengths of the two sequences."
+$nl
+"Combinators which pair every element of the first sequence with every element of the second:"
+{ $subsections
+ cartesian-each
+ cartesian-map
+}
+"Computing the cartesian product of two sequences:"
+{ $subsections
+ cartesian-product
+} ;
+
ARTICLE: "sequences" "Sequence operations"
"A " { $emphasis "sequence" } " is a finite, linearly-ordered collection of elements. Words for working with sequences are in the " { $vocab-link "sequences" } " vocabulary."
$nl
"binary-search"
"sets"
"sequences-trimming"
+ "sequences-cartesian"
"sequences.deep"
}
"Using sequences for looping:"
[ +gt+ ] [ { 0 0 0 0 } { 0 0 0 } <=> ] unit-test
[ +eq+ ] [ { } { } <=> ] unit-test
[ +eq+ ] [ { 1 2 3 } { 1 2 3 } <=> ] unit-test
+
+[ { { { 1 "a" } { 1 "b" } } { { 2 "a" } { 2 "b" } } } ]
+[ { 1 2 } { "a" "b" } cartesian-product ] unit-test
: push-if ( elt quot accum -- )
[ keep ] dip rot [ push ] [ 2drop ] if ; inline
-: selector-for ( quot exemplar -- quot accum )
+: selector-for ( quot exemplar -- selector accum )
[ length ] keep new-resizable [ [ push-if ] 2curry ] keep ; inline
-: selector ( quot -- quot accum )
+: selector ( quot -- selector accum )
V{ } selector-for ; inline
: filter-as ( seq quot exemplar -- subseq )
: push-either ( elt quot accum1 accum2 -- )
[ keep swap ] 2dip ? push ; inline
-: 2selector ( quot -- quot accum1 accum2 )
+: 2selector ( quot -- selector accum1 accum2 )
V{ } clone V{ } clone [ [ push-either ] 3curry ] 2keep ; inline
: partition ( seq quot -- trueseq falseseq )
: count ( seq quot -- n ) [ 1 0 ? ] compose map-sum ; inline
+: cartesian-each ( seq1 seq2 quot -- )
+ [ with each ] 2curry each ; inline
+
+: cartesian-map ( seq1 seq2 quot -- newseq )
+ [ with map ] 2curry map ; inline
+
+: cartesian-product ( seq1 seq2 -- newseq )
+ [ { } 2sequence ] cartesian-map ;
+
! We hand-optimize flip to such a degree because type hints
! cannot express that an array is an array of arrays yet, and
! this word happens to be performance-critical since the compiler
{ $code "TUPLE: person" "{ age integer initial: 0 }" "{ department string initial: \"Marketing\" }" "manager ;" }
} ;
+HELP: final
+{ $syntax "TUPLE: ... ; final" }
+{ $description "Declares the most recently defined word as a final tuple class which cannot be subclassed. Attempting to subclass a final class raises a " { $link bad-superclass } " error." } ;
+
HELP: initial:
{ $syntax "TUPLE: ... { slot initial: value } ... ;" }
{ $values { "slot" "a slot name" } { "value" "any literal" } }
parse-tuple-definition define-tuple-class
] define-core-syntax
+ "final" [
+ word make-final
+ ] define-core-syntax
+
"SLOT:" [
scan define-protocol-slot
] define-core-syntax
"You can store your own vocabularies in the " { $snippet "work" } " directory."
{ $subsections "add-vocab-roots" } ;
+ARTICLE: "vocabs.icons" "Vocabulary icons"
+"An icon file representing the vocabulary can be provided for use by " { $link "tools.deploy" } ". A file named " { $snippet "icon.ico" } " will be used as the application icon when the application is deployed on Windows. A file named " { $snippet "icon.icns" } " will be used when the application is deployed on MacOS X." ;
+
ARTICLE: "vocabs.loader" "Vocabulary loader"
-"The vocabulary loader combines the vocabulary system with " { $link "parser" } " in order to implement automatic loading of vocabulary source files. The vocabulary loader is implemented in the " { $vocab-link "vocabs.loader" } " vocabulary."
-$nl
-"When an attempt is made to use a vocabulary that has not been loaded into the image, the vocabulary loader is asked to locate the vocabulary's source files, and load them."
+"The " { $link POSTPONE: USE: } " and " { $link POSTPONE: USING: } " words load vocabularies using the vocabulary loader. The vocabulary loader is implemented in the " { $vocab-link "vocabs.loader" } " vocabulary."
$nl
"The vocabulary loader searches for vocabularies in a set of directories known as vocabulary roots."
{ $subsections "vocabs.roots" }
{ { $snippet "foo/bar/bar-docs.factor" } " - documentation, see " { $link "writing-help" } }
{ { $snippet "foo/bar/bar-tests.factor" } " - unit tests, see " { $link "tools.test" } }
}
-"Finally, optional three text files may contain meta-data:"
-{ $list
- { { $snippet "foo/bar/authors.txt" } " - a series of lines, with one author name per line. These are listed under " { $link "vocab-authors" } }
- { { $snippet "foo/bar/summary.txt" } " - a one-line description" }
- { { $snippet "foo/bar/tags.txt" } " - a whitespace-separated list of tags which classify the vocabulary. Consult " { $link "vocab-tags" } " for a list of existing tags you can re-use" }
-}
-"The " { $link POSTPONE: USE: } " and " { $link POSTPONE: USING: } " words load vocabularies which have not been loaded yet, as needed."
-$nl
+"Optional text files may contain metadata."
+{ $subsections "vocabs.metadata" "vocabs.icons" }
"Vocabularies can also be loaded at run time, without altering the vocabulary search path. This is done by calling a word which loads a vocabulary if it is not in the image, doing nothing if it is:"
{ $subsections require }
"The above word will only ever load a vocabulary once in a given session. There is another word which unconditionally loads vocabulary from disk, regardless of whether or not is has already been loaded:"
-! Copyright (C) 2007, 2009 Eduardo Cavazos, Slava Pestov.
+! Copyright (C) 2007, 2010 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces make sequences io io.files io.pathnames kernel
assocs words vocabs definitions parser continuations hashtables
SYMBOL: load-help?
+! Defined by vocabs.metadata
+SYMBOL: check-vocab-hook
+
+check-vocab-hook [ [ drop ] ] initialize
+
<PRIVATE
: load-source ( vocab -- )
+ dup check-vocab-hook get call( vocab -- )
[
+parsing+ >>source-loaded?
dup vocab-source-path [ parse-file ] [ [ ] ] if*
] [ [ swap add-to-blacklist ] keep rethrow ] recover ;
M: vocab-link (load-vocab)
- vocab-name create-vocab (load-vocab) ;
+ vocab-name (load-vocab) ;
-M: string (load-vocab)
- create-vocab (load-vocab) ;
+M: string (load-vocab) create-vocab (load-vocab) ;
PRIVATE>
<< global [ "count-me" inc ] bind >>
-: v-l-t-a-hello 4 ;
+: v-l-t-a-hello ( -- a ) 4 ;
-: byebye v-l-t-a-hello ;
+: byebye ( -- a ) v-l-t-a-hello ;
[ this is an error
M: word crossref?
dup "forgotten" word-prop [ drop f ] [ vocabulary>> >boolean ] if ;
-: inline? ( word -- ? ) "inline" word-prop ; inline
-
GENERIC: subwords ( word -- seq )
M: word subwords drop f ;
+GENERIC: parent-word ( word -- word/f )
+
+M: word parent-word drop f ;
+
: define ( word def -- )
over changed-definition [ ] like >>def drop ;
: make-deprecated ( word -- )
t "deprecated" set-word-prop ;
+: inline? ( word -- ? ) "inline" word-prop ; inline
+
ERROR: cannot-be-inline word ;
GENERIC: make-inline ( word -- )
bi
] if ;
+: define-inline ( word def effect -- )
+ [ define-declared ] [ 2drop make-inline ] 3bi ;
+
: make-recursive ( word -- )
t "recursive" set-word-prop ;
+GENERIC: flushable? ( word -- ? )
+
+M: word flushable?
+ [ "flushable" word-prop ]
+ [ parent-word dup [ flushable? ] when ] bi or ;
+
: make-flushable ( word -- )
t "flushable" set-word-prop ;
-: make-foldable ( word -- )
- dup make-flushable t "foldable" set-word-prop ;
-
-: define-inline ( word def effect -- )
- [ define-declared ] [ 2drop make-inline ] 3bi ;
+GENERIC: foldable? ( word -- ? )
-GENERIC: flushable? ( word -- ? )
+M: word foldable?
+ [ "foldable" word-prop ]
+ [ parent-word dup [ foldable? ] when ] bi or ;
-M: word flushable? "flushable" word-prop ;
+: make-foldable ( word -- )
+ dup make-flushable t "foldable" set-word-prop ;
GENERIC: reset-word ( word -- )
M: word forget*
dup "forgotten" word-prop [ drop ] [
+ [ subwords forget-all ]
[ [ name>> ] [ vocabulary>> vocab-words ] bi delete-at ]
[ t "forgotten" set-word-prop ]
- bi
+ tri
] if ;
M: word hashcode*
-comments
-annotation
+tools
} case ;
: check-chunk ( chunk id class -- ? )
- heap-size [ id= ] [ [ length ] dip >= ] bi-curry* bi and ;
+ heap-size [ id= ] [ [ length ] dip >= ] bi-curry* bi and ; inline
! (c)2007, 2010 Chris Double, Joe Groff bsd license
-USING: accessors alien.c-types audio.engine byte-arrays classes.struct
-combinators destructors fry io io.files io.encodings.binary
-kernel libc locals make math math.order math.parser ogg ogg.vorbis
-sequences specialized-arrays specialized-vectors ;
+USING: accessors alien alien.c-types audio.engine byte-arrays
+classes.struct combinators destructors fry io io.files
+io.encodings.binary kernel libc locals make math math.order
+math.parser ogg ogg.vorbis sequences specialized-arrays
+specialized-vectors ;
FROM: alien.c-types => float short void* ;
SPECIALIZED-ARRAYS: float void* ;
SPECIALIZED-VECTOR: short
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.functions tuple-arrays accessors fry sequences
prettyprint ;
IN: benchmark.tuple-arrays
-TUPLE: point { x float } { y float } { z float } ;
+TUPLE: point { x float } { y float } { z float } ; final
TUPLE-ARRAY: point
+++ /dev/null
-! Copyright (C) 2010 Erik Charlebois
-! See http:// factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.syntax classes.struct combinators
-combinators.short-circuit kernel math math.order sequences
-specialized-arrays.instances.alien.c-types.void* typed
-specialized-arrays locals system alien.libraries ;
-IN: chipmunk
-
-<< "chipmunk" {
- { [ os windows? ] [ "chipmunk.dll" ] }
- { [ os macosx? ] [ "libchipmunk.dylib" ] }
- { [ os unix? ] [ "libchipmunk.so" ] }
- } cond "cdecl" add-library >>
-LIBRARY: chipmunk
-
-! chipmunk_types.h
-TYPEDEF: double cpFloat
-STRUCT: cpVect
- { x cpFloat }
- { y cpFloat } ;
-SPECIALIZED-ARRAY: cpVect
-
-TYPEDEF: uint cpHashValue
-TYPEDEF: void* cpDataPointer
-TYPEDEF: uint cpCollisionType
-TYPEDEF: uint cpLayers
-TYPEDEF: uint cpGroup
-
-CONSTANT: CP_NO_GROUP 0
-CONSTANT: CP_ALL_LAYERS HEX: ffffffff
-
-! cpVect.h
-TYPED: cpv ( x y -- v: cpVect )
- cpVect <struct-boa> ; inline
-
-TYPED: cpvzero ( -- v: cpVect )
- 0.0 0.0 cpv ; inline
-
-FUNCTION: cpFloat cpvlength ( cpVect v ) ;
-FUNCTION: cpVect cpvslerp ( cpVect v1, cpVect v2, cpFloat t ) ;
-FUNCTION: cpVect cpvslerpconst ( cpVect v1, cpVect v2, cpFloat a ) ;
-FUNCTION: cpVect cpvforangle ( cpFloat a ) ;
-FUNCTION: cpFloat cpvtoangle ( cpVect v ) ;
-FUNCTION: char* cpvstr ( cpVect v ) ;
-
-TYPED: cpvadd ( v1: cpVect v2: cpVect -- v3: cpVect )
- [ [ x>> ] bi@ + ]
- [ [ y>> ] bi@ + ] 2bi cpv ; inline
-
-TYPED: cpvneg ( v1: cpVect -- v2: cpVect )
- [ x>> ] [ y>> ] bi [ neg ] bi@ cpv ; inline
-
-TYPED: cpvsub ( v1: cpVect v2: cpVect -- v3: cpVect )
- [ [ x>> ] bi@ - ]
- [ [ y>> ] bi@ - ] 2bi cpv ; inline
-
-TYPED: cpvmult ( v1: cpVect s -- v2: cpVect )
- [ swap x>> * ]
- [ swap y>> * ] 2bi cpv ; inline
-
-TYPED: cpvdot ( v1: cpVect v2: cpVect -- s )
- [ [ x>> ] bi@ * ]
- [ [ y>> ] bi@ * ] 2bi + ; inline
-
-TYPED: cpvcross ( v1: cpVect v2: cpVect -- s )
- [ [ x>> ] [ y>> ] bi* * ]
- [ [ y>> ] [ x>> ] bi* * ] 2bi - ; inline
-
-TYPED: cpvperp ( v1: cpVect -- v2: cpVect )
- [ y>> neg ] [ x>> ] bi cpv ; inline
-
-TYPED: cpvrperp ( v1: cpVect -- v2: cpVect )
- [ y>> ] [ x>> neg ] bi cpv ; inline
-
-TYPED: cpvproject ( v1: cpVect v2: cpVect -- v3: cpVect )
- [ nip ]
- [ cpvdot ]
- [ nip dup cpvdot ]
- 2tri / cpvmult ; inline
-
-TYPED: cpvrotate ( v1: cpVect v2: cpVect -- v3: cpVect )
- [
- [ [ x>> ] bi@ * ]
- [ [ y>> ] bi@ * ] 2bi -
- ]
- [
- [ [ x>> ] [ y>> ] bi* * ]
- [ [ y>> ] [ x>> ] bi* * ] 2bi +
- ] 2bi cpv ; inline
-
-TYPED: cpvunrotate ( v1: cpVect v2: cpVect -- v3: cpVect )
- [
- [ [ x>> ] bi@ * ]
- [ [ y>> ] bi@ * ] 2bi +
- ]
- [
- [ [ y>> ] [ x>> ] bi* * ]
- [ [ x>> ] [ y>> ] bi* * ] 2bi -
- ] 2bi cpv ; inline
-
-TYPED: cpvlengthsq ( v: cpVect -- s )
- dup cpvdot ; inline
-
-TYPED: cpvlerp ( v1: cpVect v2: cpVect s -- v3: cpVect )
- [ nip 1.0 swap - cpvmult ]
- [ cpvmult nip ] 3bi cpvadd ; inline
-
-TYPED: cpvnormalize ( v1: cpVect -- v2: cpVect )
- dup cpvlength 1.0 swap / cpvmult ; inline
-
-TYPED: cpvnormalize_safe ( v1: cpVect -- v2: cpVect )
- dup [ x>> 0.0 = ] [ y>> 0.0 = ] bi and
- [ drop cpvzero ]
- [ cpvnormalize ] if ; inline
-
-TYPED: cpvclamp ( v1: cpVect len -- v2: cpVect )
- 2dup
- [ dup cpvdot ]
- [ sq ] 2bi* >
- [ [ cpvnormalize ] dip cpvmult ]
- [ drop ] if ; inline
-
-TYPED: cpvlerpconst ( v1: cpVect v2: cpVect d -- v3: cpVect )
- [ 2drop ]
- [ [ swap cpvsub ] dip cpvclamp ] 3bi cpvadd ; inline
-
-TYPED: cpvdist ( v1: cpVect v2: cpVect -- dist )
- cpvsub cpvlength ; inline
-
-TYPED: cpvdistsq ( v1: cpVect v2: cpVect -- distsq )
- cpvsub cpvlengthsq ; inline
-
-TYPED: cpvnear ( v1: cpVect v2: cpVect dist -- ? )
- [ cpvdistsq ] dip sq < ; inline
-
-! cpBB.h
-STRUCT: cpBB
- { l cpFloat }
- { b cpFloat }
- { r cpFloat }
- { t cpFloat } ;
-
-TYPED: cpBBNew ( l b r t -- cpbb: cpBB )
- cpBB <struct-boa> ; inline
-
-TYPED: cpBBintersects ( a: cpBB b: cpBB -- ? )
- {
- [ [ l>> ] [ r>> ] bi* <= ]
- [ [ r>> ] [ l>> ] bi* > ]
- [ [ b>> ] [ t>> ] bi* <= ]
- [ [ t>> ] [ b>> ] bi* > ]
- } 2&& ; inline
-
-TYPED: cpBBcontainsBB ( bb: cpBB other: cpBB -- ? )
- {
- [ [ l>> ] bi@ < ]
- [ [ r>> ] bi@ > ]
- [ [ b>> ] bi@ < ]
- [ [ t>> ] bi@ > ]
- } 2&& ; inline
-
-TYPED: cpBBcontainsVect ( bb: cpBB v: cpVect -- ? )
- {
- [ [ l>> ] [ x>> ] bi* < ]
- [ [ r>> ] [ x>> ] bi* > ]
- [ [ b>> ] [ y>> ] bi* < ]
- [ [ t>> ] [ y>> ] bi* > ]
- } 2&& ; inline
-
-TYPED: cpBBmerge ( a: cpBB b: cpBB -- c: cpBB )
- {
- [ [ l>> ] bi@ min ]
- [ [ b>> ] bi@ min ]
- [ [ r>> ] bi@ max ]
- [ [ t>> ] bi@ max ]
- } 2cleave cpBBNew ; inline
-
-TYPED: cpBBexpand ( bb: cpBB v: cpVect -- b: cpBB )
- {
- [ [ l>> ] [ x>> ] bi* min ]
- [ [ b>> ] [ y>> ] bi* min ]
- [ [ r>> ] [ x>> ] bi* max ]
- [ [ t>> ] [ y>> ] bi* max ]
- } 2cleave cpBBNew ; inline
-
-FUNCTION: cpVect cpBBClampVect ( cpBB bb, cpVect v ) ;
-FUNCTION: cpVect cpBBWrapVect ( cpBB bb, cpVect v ) ;
-
-! cpBody.h
-C-TYPE: cpBody
-CALLBACK: void cpBodyVelocityFunc ( cpBody* body, cpVect gravity, cpFloat damping, cpFloat dt ) ;
-CALLBACK: void cpBodyPositionFunc ( cpBody* body, cpFloat dt ) ;
-
-STRUCT: cpBody
- { velocity_func cpBodyVelocityFunc }
- { position_func cpBodyPositionFunc }
- { m cpFloat }
- { m_inv cpFloat }
- { i cpFloat }
- { i_inv cpFloat }
- { p cpVect }
- { v cpVect }
- { f cpVect }
- { a cpFloat }
- { w cpFloat }
- { t cpFloat }
- { rot cpVect }
- { data cpDataPointer }
- { v_limit cpFloat }
- { w_limit cpFloat }
- { v_bias cpVect }
- { w_bias cpFloat } ;
-
-FUNCTION: cpBody* cpBodyAlloc ( ) ;
-FUNCTION: cpBody* cpBodyInit ( cpBody* body, cpFloat m, cpFloat i ) ;
-FUNCTION: cpBody* cpBodyNew ( cpFloat m, cpFloat i ) ;
-FUNCTION: void cpBodyDestroy ( cpBody* body ) ;
-FUNCTION: void cpBodyFree ( cpBody* body ) ;
-FUNCTION: void cpBodySetMass ( cpBody* body, cpFloat m ) ;
-FUNCTION: void cpBodySetMoment ( cpBody* body, cpFloat i ) ;
-FUNCTION: void cpBodySetAngle ( cpBody* body, cpFloat a ) ;
-FUNCTION: void cpBodySlew ( cpBody* body, cpVect pos, cpFloat dt ) ;
-FUNCTION: void cpBodyUpdateVelocity ( cpBody* body, cpVect gravity, cpFloat damping, cpFloat dt ) ;
-FUNCTION: void cpBodyUpdatePosition ( cpBody* body, cpFloat dt ) ;
-
-TYPED: cpBodyLocal2World ( body: cpBody v: cpVect -- v2: cpVect )
- [ drop p>> ]
- [ swap rot>> cpvrotate ] 2bi cpvadd ; inline
-
-TYPED: cpBodyWorld2Local ( body: cpBody v: cpVect -- v2: cpVect )
- [ swap p>> cpvsub ]
- [ drop rot>> ] 2bi cpvunrotate ; inline
-
-TYPED: cpBodyApplyImpulse ( body: cpBody j: cpVect r: cpVect -- )
- [
- drop
- [ drop dup v>> ]
- [ swap m_inv>> cpvmult ] 2bi cpvadd >>v drop
- ]
- [
- [ 2drop dup w_bias>> ]
- [ swap cpvcross [ i_inv>> ] dip * ] 3bi + >>w_bias drop
- ] 3bi ; inline
-
-FUNCTION: void cpBodyResetForces ( cpBody* body ) ;
-FUNCTION: void cpBodyApplyForce ( cpBody* body, cpVect f, cpVect r ) ;
-FUNCTION: void cpApplyDampedSpring ( cpBody* a, cpBody* b, cpVect anchr1, cpVect anchr2, cpFloat rlen, cpFloat k, cpFloat dmp, cpFloat dt ) ;
-
-! cpArray.h
-STRUCT: cpArray
- { num int }
- { max int }
- { arr void** } ;
-
-CALLBACK: void cpArrayIter ( void* ptr, void* data ) ;
-
-FUNCTION: cpArray* cpArrayAlloc ( ) ;
-FUNCTION: cpArray* cpArrayInit ( cpArray* arr, int size ) ;
-FUNCTION: cpArray* cpArrayNew ( int size ) ;
-FUNCTION: void cpArrayDestroy ( cpArray* arr ) ;
-FUNCTION: void cpArrayFree ( cpArray* arr ) ;
-FUNCTION: void cpArrayPush ( cpArray* arr, void* object ) ;
-FUNCTION: void cpArrayDeleteIndex ( cpArray* arr, int idx ) ;
-FUNCTION: void cpArrayDeleteObj ( cpArray* arr, void* obj ) ;
-FUNCTION: void cpArrayEach ( cpArray* arr, cpArrayIter iterFunc, void* data ) ;
-FUNCTION: int cpArrayContains ( cpArray* arr, void* ptr ) ;
-
-! cpHashSet.h
-STRUCT: cpHashSetBin
- { elt void* }
- { hash cpHashValue }
- { next cpHashSetBin* } ;
-
-CALLBACK: int cpHashSetEqlFunc ( void* ptr, void* elt ) ;
-CALLBACK: void* cpHashSetTransFunc ( void* ptr, void* data ) ;
-CALLBACK: void cpHashSetIterFunc ( void* elt, void* data ) ;
-CALLBACK: int cpHashSetFilterFunc ( void* elt, void* data ) ;
-
-STRUCT: cpHashSet
- { entries int }
- { size int }
- { eql cpHashSetEqlFunc }
- { trans cpHashSetTransFunc }
- { default_value void* }
- { table cpHashSetBin** } ;
-
-FUNCTION: void cpHashSetDestroy ( cpHashSet* set ) ;
-FUNCTION: void cpHashSetFree ( cpHashSet* set ) ;
-FUNCTION: cpHashSet* cpHashSetAlloc ( ) ;
-FUNCTION: cpHashSet* cpHashSetInit ( cpHashSet* set, int size, cpHashSetEqlFunc eqlFunc, cpHashSetTransFunc trans ) ;
-FUNCTION: cpHashSet* cpHashSetNew ( int size, cpHashSetEqlFunc eqlFunc, cpHashSetTransFunc trans ) ;
-FUNCTION: void* cpHashSetInsert ( cpHashSet* set, cpHashValue hash, void* ptr, void* data ) ;
-FUNCTION: void* cpHashSetRemove ( cpHashSet* set, cpHashValue hash, void* ptr ) ;
-FUNCTION: void* cpHashSetFind ( cpHashSet* set, cpHashValue hash, void* ptr ) ;
-FUNCTION: void cpHashSetEach ( cpHashSet* set, cpHashSetIterFunc func, void* data ) ;
-FUNCTION: void cpHashSetFilter ( cpHashSet* set, cpHashSetFilterFunc func, void* data ) ;
-
-! cpSpaceHash.h
-STRUCT: cpHandle
- { obj void* }
- { retain int }
- { stamp int } ;
-
-STRUCT: cpSpaceHashBin
- { handle cpHandle* }
- { next cpSpaceHashBin* } ;
-
-CALLBACK: cpBB cpSpaceHashBBFunc ( void* obj ) ;
-
-STRUCT: cpSpaceHash
- { numcells int }
- { celldim cpFloat }
- { bbfunc cpSpaceHashBBFunc }
- { handleSet cpHashSet* }
- { table cpSpaceHashBin** }
- { bins cpSpaceHashBin* }
- { stamp int } ;
-
-FUNCTION: cpSpaceHash* cpSpaceHashAlloc ( ) ;
-FUNCTION: cpSpaceHash* cpSpaceHashInit ( cpSpaceHash* hash, cpFloat celldim, int cells, cpSpaceHashBBFunc bbfunc ) ;
-FUNCTION: cpSpaceHash* cpSpaceHashNew ( cpFloat celldim, int cells, cpSpaceHashBBFunc bbfunc ) ;
-FUNCTION: void cpSpaceHashDestroy ( cpSpaceHash* hash ) ;
-FUNCTION: void cpSpaceHashFree ( cpSpaceHash* hash ) ;
-FUNCTION: void cpSpaceHashResize ( cpSpaceHash* hash, cpFloat celldim, int numcells ) ;
-FUNCTION: void cpSpaceHashInsert ( cpSpaceHash* hash, void* obj, cpHashValue id, cpBB bb ) ;
-FUNCTION: void cpSpaceHashRemove ( cpSpaceHash* hash, void* obj, cpHashValue id ) ;
-CALLBACK: void cpSpaceHashIterator ( void* obj, void* data ) ;
-FUNCTION: void cpSpaceHashEach ( cpSpaceHash* hash, cpSpaceHashIterator func, void* data ) ;
-FUNCTION: void cpSpaceHashRehash ( cpSpaceHash* hash ) ;
-FUNCTION: void cpSpaceHashRehashObject ( cpSpaceHash* hash, void* obj, cpHashValue id ) ;
-CALLBACK: void cpSpaceHashQueryFunc ( void* obj1, void* obj2, void* data ) ;
-FUNCTION: void cpSpaceHashPointQuery ( cpSpaceHash* hash, cpVect point, cpSpaceHashQueryFunc func, void* data ) ;
-FUNCTION: void cpSpaceHashQuery ( cpSpaceHash* hash, void* obj, cpBB bb, cpSpaceHashQueryFunc func, void* data ) ;
-FUNCTION: void cpSpaceHashQueryRehash ( cpSpaceHash* hash, cpSpaceHashQueryFunc func, void* data ) ;
-CALLBACK: cpFloat cpSpaceHashSegmentQueryFunc ( void* obj1, void* obj2, void* data ) ;
-FUNCTION: void cpSpaceHashSegmentQuery ( cpSpaceHash* hash, void* obj, cpVect a, cpVect b, cpFloat t_exit, cpSpaceHashSegmentQueryFunc func, void* data ) ;
-
-! cpShape.h
-C-TYPE: cpShape
-C-TYPE: cpShapeClass
-
-STRUCT: cpSegmentQueryInfo
- { shape cpShape* }
- { t cpFloat }
- { n cpVect } ;
-
-C-ENUM:
- CP_CIRCLE_SHAPE
- CP_SEGMENT_SHAPE
- CP_POLY_SHAPE
- CP_NUM_SHAPES ;
-TYPEDEF: int cpShapeType
-
-CALLBACK: cpBB cacheData_cb ( cpShape* shape, cpVect p, cpVect rot ) ;
-CALLBACK: void destroy_cb ( cpShape* shape ) ;
-CALLBACK: int pointQuery_cb ( cpShape* shape, cpVect p ) ;
-CALLBACK: void segmentQuery_cb ( cpShape* shape, cpVect a, cpVect b, cpSegmentQueryInfo* info ) ;
-
-STRUCT: cpShapeClass
- { type cpShapeType }
- { cacheData cacheData_cb }
- { destroy destroy_cb }
- { pointQuery pointQuery_cb }
- { segmentQuery segmentQuery_cb } ;
-
-STRUCT: cpShape
- { klass cpShapeClass* }
- { body cpBody* }
- { bb cpBB }
- { sensor int }
- { e cpFloat }
- { u cpFloat }
- { surface_v cpVect }
- { data cpDataPointer }
- { collision_type cpCollisionType }
- { group cpGroup }
- { layers cpLayers }
- { hashid cpHashValue } ;
-
-FUNCTION: cpShape* cpShapeInit ( cpShape* shape, cpShapeClass* klass, cpBody* body ) ;
-FUNCTION: void cpShapeDestroy ( cpShape* shape ) ;
-FUNCTION: void cpShapeFree ( cpShape* shape ) ;
-FUNCTION: cpBB cpShapeCacheBB ( cpShape* shape ) ;
-FUNCTION: int cpShapePointQuery ( cpShape* shape, cpVect p ) ;
-
-STRUCT: cpCircleShape
- { shape cpShape }
- { c cpVect }
- { r cpFloat }
- { tc cpVect } ;
-
-FUNCTION: cpCircleShape* cpCircleShapeAlloc ( ) ;
-FUNCTION: cpCircleShape* cpCircleShapeInit ( cpCircleShape* circle, cpBody* body, cpFloat radius, cpVect offset ) ;
-FUNCTION: cpShape* cpCircleShapeNew ( cpBody* body, cpFloat radius, cpVect offset ) ;
-
-STRUCT: cpSegmentShape
- { shape cpShape }
- { a cpVect }
- { b cpVect }
- { n cpVect }
- { r cpFloat }
- { ta cpVect }
- { tb cpVect }
- { tn cpVect } ;
-
-FUNCTION: cpSegmentShape* cpSegmentShapeAlloc ( ) ;
-FUNCTION: cpSegmentShape* cpSegmentShapeInit ( cpSegmentShape* seg, cpBody* body, cpVect a, cpVect b, cpFloat radius ) ;
-FUNCTION: cpShape* cpSegmentShapeNew ( cpBody* body, cpVect a, cpVect b, cpFloat radius ) ;
-FUNCTION: void cpResetShapeIdCounter ( ) ;
-FUNCTION: void cpSegmentQueryInfoPrint ( cpSegmentQueryInfo* info ) ;
-FUNCTION: int cpShapeSegmentQuery ( cpShape* shape, cpVect a, cpVect b, cpSegmentQueryInfo* info ) ;
-
-TYPED: cpSegmentQueryHitPoint ( start: cpVect end: cpVect info: cpSegmentQueryInfo -- hit-point: cpVect )
- t>> cpvlerp ; inline
-
-TYPED: cpSegmentQueryHitDist ( start: cpVect end: cpVect info: cpSegmentQueryInfo -- hit-dist )
- t>> [ cpvdist ] dip * ; inline
-
-! cpPolyShape.h
-STRUCT: cpPolyShapeAxis
- { n cpVect }
- { d cpFloat } ;
-SPECIALIZED-ARRAY: cpPolyShapeAxis
-
-STRUCT: cpPolyShape
- { shape cpShape }
- { numVerts int }
- { verts cpVect* }
- { axes cpPolyShapeAxis* }
- { tVerts cpVect* }
- { tAxes cpPolyShapeAxis* } ;
-
-FUNCTION: cpPolyShape* cpPolyShapeAlloc ( ) ;
-FUNCTION: cpPolyShape* cpPolyShapeInit ( cpPolyShape* poly, cpBody* body, int numVerts, cpVect* verts, cpVect offset ) ;
-FUNCTION: cpShape* cpPolyShapeNew ( cpBody* body, int numVerts, cpVect* verts, cpVect offset ) ;
-FUNCTION: int cpPolyValidate ( cpVect* verts, int numVerts ) ;
-FUNCTION: int cpPolyShapeGetNumVerts ( cpShape* shape ) ;
-FUNCTION: cpVect cpPolyShapeGetVert ( cpShape* shape, int idx ) ;
-
-TYPED: cpPolyShapeValueOnAxis ( poly: cpPolyShape n: cpVect d -- min-dist )
- swap rot [ numVerts>> ] [ tVerts>> swap <direct-cpVect-array> ] bi swap
- [ cpvdot ] curry [ min ] reduce swap - ; inline
-
-TYPED: cpPolyShapeContainsVert ( poly: cpPolyShape v: cpVect -- ? )
- swap [ numVerts>> ] [ tAxes>> swap <direct-cpPolyShapeAxis-array> ] bi swap
- [
- [ [ n>> ] dip cpvdot ] [ drop d>> ] 2bi -
- ] curry [ max ] reduce 0.0 <= ; inline
-
-TYPED: cpPolyShapeContainsVertPartial ( poly: cpPolyShape v: cpVect n: cpVect -- ? )
- rot [ numVerts>> ] [ tAxes>> swap <direct-cpPolyShapeAxis-array> ] bi -rot
- [| axis v n |
- axis n>> n cpvdot 0.0 < 0
- [ 0.0 ]
- [ axis n>> v cpvdot axis d>> - ]
- if
- ] 2curry [ max ] reduce 0.0 <= ; inline
-
-! cpArbiter.h
-C-TYPE: cpArbiter
-C-TYPE: cpSpace
-C-TYPE: cpCollisionHandler
-
-STRUCT: cpContact
- { p cpVect }
- { n cpVect }
- { dist cpFloat }
- { r1 cpVect }
- { r2 cpVect }
- { nMass cpFloat }
- { tMass cpFloat }
- { bounce cpFloat }
- { jnAcc cpFloat }
- { jtAcc cpFloat }
- { jBias cpFloat }
- { bias cpFloat }
- { hash cpHashValue } ;
-
-FUNCTION: cpContact* cpContactInit ( cpContact* con, cpVect p, cpVect n, cpFloat dist, cpHashValue hash ) ;
-
-C-ENUM:
- cpArbiterStateNormal
- cpArbiterStateFirstColl
- cpArbiterStateIgnore ;
-TYPEDEF: int cpArbiterState
-
-STRUCT: cpArbiter
- { numContacts int }
- { contacts cpContact* }
- { a cpShape* }
- { b cpShape* }
- { e cpFloat }
- { u cpFloat }
- { surface_vr cpVect }
- { stamp int }
- { handler cpCollisionHandler* }
- { swappedColl char }
- { state char } ;
-
-FUNCTION: cpArbiter* cpArbiterAlloc ( ) ;
-FUNCTION: cpArbiter* cpArbiterInit ( cpArbiter* arb, cpShape* a, cpShape* b ) ;
-FUNCTION: cpArbiter* cpArbiterNew ( cpShape* a, cpShape* b ) ;
-FUNCTION: void cpArbiterDestroy ( cpArbiter* arb ) ;
-FUNCTION: void cpArbiterFree ( cpArbiter* arb ) ;
-FUNCTION: void cpArbiterUpdate ( cpArbiter* arb, cpContact* contacts, int numContacts, cpCollisionHandler* handler, cpShape* a, cpShape* b ) ;
-FUNCTION: void cpArbiterPreStep ( cpArbiter* arb, cpFloat dt_inv ) ;
-FUNCTION: void cpArbiterApplyCachedImpulse ( cpArbiter* arb ) ;
-FUNCTION: void cpArbiterApplyImpulse ( cpArbiter* arb, cpFloat eCoef ) ;
-FUNCTION: cpVect cpArbiterTotalImpulse ( cpArbiter* arb ) ;
-FUNCTION: cpVect cpArbiterTotalImpulseWithFriction ( cpArbiter* arb ) ;
-FUNCTION: void cpArbiterIgnore ( cpArbiter* arb ) ;
-
-TYPED: cpArbiterGetShapes ( arb: cpArbiter -- a: cpShape b: cpShape )
- dup swappedColl>> 0 = [
- [ a>> cpShape memory>struct ] [ b>> cpShape memory>struct ] bi
- ] [
- [ b>> cpShape memory>struct ] [ a>> cpShape memory>struct ] bi
- ] if ; inline
-
-TYPED: cpArbiterIsFirstContact ( arb: cpArbiter -- ? )
- state>> cpArbiterStateFirstColl = ; inline
-
-TYPED: cpArbiterGetNormal ( arb: cpArbiter i -- n: cpVect )
- [
- swap
- [ numContacts>> ]
- [ contacts>> swap <direct-void*-array> ] bi nth cpContact memory>struct n>>
- ]
- [
- drop swappedColl>> 0 = [ ] [ cpvneg ] if
- ] 2bi ; inline
-
-TYPED: cpArbiterGetPoint ( arb: cpArbiter i -- p: cpVect )
- swap
- [ numContacts>> ]
- [ contacts>> swap <direct-void*-array> ] bi
- nth cpContact memory>struct p>> ; inline
-
-! cpCollision.h
-FUNCTION: int cpCollideShapes ( cpShape* a, cpShape* b, cpContact** arr ) ;
-
-! cpConstraint.h
-
-C-TYPE: cpConstraintClass
-C-TYPE: cpConstraint
-
-CALLBACK: void cpConstraintPreStepFunction ( cpConstraint* constraint, cpFloat dt, cpFloat dt_inv ) ;
-CALLBACK: void cpConstraintApplyImpulseFunction ( cpConstraint* constraint ) ;
-CALLBACK: cpFloat cpConstraintGetImpulseFunction ( cpConstraint* constraint ) ;
-
-STRUCT: cpConstraintClass
- { preStep cpConstraintPreStepFunction }
- { applyImpulse cpConstraintApplyImpulseFunction }
- { getImpulse cpConstraintGetImpulseFunction } ;
-
-STRUCT: cpConstraint
- { klass cpConstraintClass* }
- { a cpBody* }
- { b cpBody* }
- { maxForce cpFloat }
- { biasCoef cpFloat }
- { maxBias cpFloat }
- { data cpDataPointer } ;
-
-FUNCTION: void cpConstraintDestroy ( cpConstraint* constraint ) ;
-FUNCTION: void cpConstraintFree ( cpConstraint* constraint ) ;
-FUNCTION: void cpConstraintCheckCast ( cpConstraint* constraint, cpConstraintClass* klass ) ;
-
-! cpPinJoint.h
-FUNCTION: cpConstraintClass* cpPinJointGetClass ( ) ;
-
-STRUCT: cpPinJoint
- { constraint cpConstraint }
- { anchr1 cpVect }
- { anchr2 cpVect }
- { dist cpFloat }
- { r1 cpVect }
- { r2 cpVect }
- { n cpVect }
- { nMass cpFloat }
- { jnAcc cpFloat }
- { jnMax cpFloat }
- { bias cpFloat } ;
-
-FUNCTION: cpPinJoint* cpPinJointAlloc ( ) ;
-FUNCTION: cpPinJoint* cpPinJointInit ( cpPinJoint* joint, cpBody* a, cpBody* b, cpVect anchr1, cpVect anchr2 ) ;
-FUNCTION: cpConstraint* cpPinJointNew ( cpBody* a, cpBody* b, cpVect anchr1, cpVect anchr2 ) ;
-
-! cpSlideJoint.h
-FUNCTION: cpConstraintClass* cpSlideJointGetClass ( ) ;
-
-STRUCT: cpSlideJoint
- { constraint cpConstraint }
- { anchr1 cpVect }
- { anchr2 cpVect }
- { min cpFloat }
- { max cpFloat }
- { r1 cpVect }
- { r2 cpVect }
- { n cpVect }
- { nMass cpFloat }
- { jnAcc cpFloat }
- { jnMax cpFloat }
- { bias cpFloat } ;
-
-FUNCTION: cpSlideJoint* cpSlideJointAlloc ( ) ;
-FUNCTION: cpSlideJoint* cpSlideJointInit ( cpSlideJoint* joint, cpBody* a, cpBody* b, cpVect anchr1, cpVect anchr2, cpFloat min, cpFloat max ) ;
-FUNCTION: cpConstraint* cpSlideJointNew ( cpBody* a, cpBody* b, cpVect anchr1, cpVect anchr2, cpFloat min, cpFloat max ) ;
-
-! cpPivotJoint.h
-FUNCTION: cpConstraintClass* cpPivotJointGetClass ( ) ;
-
-STRUCT: cpPivotJoint
- { constraint cpConstraint }
- { anchr1 cpVect }
- { anchr2 cpVect }
- { r1 cpVect }
- { r2 cpVect }
- { k1 cpVect }
- { k2 cpVect }
- { jAcc cpVect }
- { jMaxLen cpFloat }
- { bias cpVect } ;
-
-FUNCTION: cpPivotJoint* cpPivotJointAlloc ( ) ;
-FUNCTION: cpPivotJoint* cpPivotJointInit ( cpPivotJoint* joint, cpBody* a, cpBody* b, cpVect anchr1, cpVect anchr2 ) ;
-FUNCTION: cpConstraint* cpPivotJointNew ( cpBody* a, cpBody* b, cpVect pivot ) ;
-FUNCTION: cpConstraint* cpPivotJointNew2 ( cpBody* a, cpBody* b, cpVect anchr1, cpVect anchr2 ) ;
-
-! cpGrooveJoint.h
-FUNCTION: cpConstraintClass* cpGrooveJointGetClass ( ) ;
-
-STRUCT: cpGrooveJoint
- { constraint cpConstraint }
- { grv_n cpVect }
- { grv_a cpVect }
- { grv_b cpVect }
- { anchr2 cpVect }
- { grv_tn cpVect }
- { clamp cpFloat }
- { r1 cpVect }
- { r2 cpVect }
- { k1 cpVect }
- { k2 cpVect }
- { jAcc cpVect }
- { jMaxLen cpFloat }
- { bias cpVect } ;
-
-FUNCTION: cpGrooveJoint* cpGrooveJointAlloc ( ) ;
-FUNCTION: cpGrooveJoint* cpGrooveJointInit ( cpGrooveJoint* joint, cpBody* a, cpBody* b, cpVect groove_a, cpVect groove_b, cpVect anchr2 ) ;
-FUNCTION: cpConstraint* cpGrooveJointNew ( cpBody* a, cpBody* b, cpVect groove_a, cpVect groove_b, cpVect anchr2 ) ;
-
-! cpDampedSpring.h
-CALLBACK: cpFloat cpDampedSpringForceFunc ( cpConstraint* spring, cpFloat dist ) ;
-FUNCTION: cpConstraintClass* cpDampedSpringGetClass ( ) ;
-
-STRUCT: cpDampedSpring
- { constraint cpConstraint }
- { anchr1 cpVect }
- { anchr2 cpVect }
- { restLength cpFloat }
- { stiffness cpFloat }
- { damping cpFloat }
- { springForceFunc cpDampedSpringForceFunc }
- { dt cpFloat }
- { target_vrn cpFloat }
- { r1 cpVect }
- { r2 cpVect }
- { nMass cpFloat }
- { n cpVect } ;
-
-FUNCTION: cpDampedSpring* cpDampedSpringAlloc ( ) ;
-FUNCTION: cpDampedSpring* cpDampedSpringInit ( cpDampedSpring* joint, cpBody* a, cpBody* b, cpVect anchr1, cpVect anchr2, cpFloat restLength, cpFloat stiffness, cpFloat damping ) ;
-FUNCTION: cpConstraint* cpDampedSpringNew ( cpBody* a, cpBody* b, cpVect anchr1, cpVect anchr2, cpFloat restLength, cpFloat stiffness, cpFloat damping ) ;
-
-! cpDampedRotarySpring.h
-CALLBACK: cpFloat cpDampedRotarySpringTorqueFunc ( cpConstraint* spring, cpFloat relativeAngle ) ;
-FUNCTION: cpConstraintClass* cpDampedRotarySpringGetClass ( ) ;
-
-STRUCT: cpDampedRotarySpring
- { constraint cpConstraint }
- { restAngle cpFloat }
- { stiffness cpFloat }
- { damping cpFloat }
- { springTorqueFunc cpDampedRotarySpringTorqueFunc }
- { dt cpFloat }
- { target_wrn cpFloat }
- { iSum cpFloat } ;
-
-FUNCTION: cpDampedRotarySpring* cpDampedRotarySpringAlloc ( ) ;
-FUNCTION: cpDampedRotarySpring* cpDampedRotarySpringInit ( cpDampedRotarySpring* joint, cpBody* a, cpBody* b, cpFloat restAngle, cpFloat stiffness, cpFloat damping ) ;
-FUNCTION: cpConstraint* cpDampedRotarySpringNew ( cpBody* a, cpBody* b, cpFloat restAngle, cpFloat stiffness, cpFloat damping ) ;
-
-! cpRotaryLimitJoint.h
-FUNCTION: cpConstraintClass* cpRotaryLimitJointGetClass ( ) ;
-
-STRUCT: cpRotaryLimitJoint
- { constraint cpConstraint }
- { min cpFloat }
- { max cpFloat }
- { iSum cpFloat }
- { bias cpFloat }
- { jAcc cpFloat }
- { jMax cpFloat } ;
-
-FUNCTION: cpRotaryLimitJoint* cpRotaryLimitJointAlloc ( ) ;
-FUNCTION: cpRotaryLimitJoint* cpRotaryLimitJointInit ( cpRotaryLimitJoint* joint, cpBody* a, cpBody* b, cpFloat min, cpFloat max ) ;
-FUNCTION: cpConstraint* cpRotaryLimitJointNew ( cpBody* a, cpBody* b, cpFloat min, cpFloat max ) ;
-
-! cpRatchetJoint.h
-FUNCTION: cpConstraintClass* cpRatchetJointGetClass ( ) ;
-
-STRUCT: cpRatchetJoint
- { constraint cpConstraint }
- { angle cpFloat }
- { phase cpFloat }
- { ratchet cpFloat }
- { iSum cpFloat }
- { bias cpFloat }
- { jAcc cpFloat }
- { jMax cpFloat } ;
-
-FUNCTION: cpRatchetJoint* cpRatchetJointAlloc ( ) ;
-FUNCTION: cpRatchetJoint* cpRatchetJointInit ( cpRatchetJoint* joint, cpBody* a, cpBody* b, cpFloat phase, cpFloat ratchet ) ;
-FUNCTION: cpConstraint* cpRatchetJointNew ( cpBody* a, cpBody* b, cpFloat phase, cpFloat ratchet ) ;
-
-! cpGearJoint.h
-FUNCTION: cpConstraintClass* cpGearJointGetClass ( ) ;
-
-STRUCT: cpGearJoint
- { constraint cpConstraint }
- { phase cpFloat }
- { ratio cpFloat }
- { ratio_inv cpFloat }
- { iSum cpFloat }
- { bias cpFloat }
- { jAcc cpFloat }
- { jMax cpFloat } ;
-
-FUNCTION: cpGearJoint* cpGearJointAlloc ( ) ;
-FUNCTION: cpGearJoint* cpGearJointInit ( cpGearJoint* joint, cpBody* a, cpBody* b, cpFloat phase, cpFloat ratio ) ;
-FUNCTION: cpConstraint* cpGearJointNew ( cpBody* a, cpBody* b, cpFloat phase, cpFloat ratio ) ;
-FUNCTION: void cpGearJointSetRatio ( cpConstraint* constraint, cpFloat value ) ;
-
-! cpSimpleMotor.h
-FUNCTION: cpConstraintClass* cpSimpleMotorGetClass ( ) ;
-
-STRUCT: cpSimpleMotor
- { constraint cpConstraint }
- { rate cpFloat }
- { iSum cpFloat }
- { jAcc cpFloat }
- { jMax cpFloat } ;
-
-FUNCTION: cpSimpleMotor* cpSimpleMotorAlloc ( ) ;
-FUNCTION: cpSimpleMotor* cpSimpleMotorInit ( cpSimpleMotor* joint, cpBody* a, cpBody* b, cpFloat rate ) ;
-FUNCTION: cpConstraint* cpSimpleMotorNew ( cpBody* a, cpBody* b, cpFloat rate ) ;
-
-! cpSpace.h
-C-TYPE: cpSpace
-
-CALLBACK: int cpCollisionBeginFunc ( cpArbiter* arb, cpSpace* space, void* data ) ;
-CALLBACK: int cpCollisionPreSolveFunc ( cpArbiter* arb, cpSpace* space, void* data ) ;
-CALLBACK: void cpCollisionPostSolveFunc ( cpArbiter* arb, cpSpace* space, void* data ) ;
-CALLBACK: void cpCollisionSeparateFunc ( cpArbiter* arb, cpSpace* space, void* data ) ;
-
-STRUCT: cpCollisionHandler
- { a cpCollisionType }
- { b cpCollisionType }
- { begin cpCollisionBeginFunc }
- { preSolve cpCollisionPreSolveFunc }
- { postSolve cpCollisionPostSolveFunc }
- { separate cpCollisionSeparateFunc }
- { data void* } ;
-
-STRUCT: cpSpace
- { iterations int }
- { elasticIterations int }
- { gravity cpVect }
- { damping cpFloat }
- { stamp int }
- { staticShapes cpSpaceHash* }
- { activeShapes cpSpaceHash* }
- { bodies cpArray* }
- { arbiters cpArray* }
- { contactSet cpHashSet* }
- { constraints cpArray* }
- { collFuncSet cpHashSet* }
- { defaultHandler cpCollisionHandler }
- { postStepCallbacks cpHashSet* } ;
-
-FUNCTION: cpSpace* cpSpaceAlloc ( ) ;
-FUNCTION: cpSpace* cpSpaceInit ( cpSpace* space ) ;
-FUNCTION: cpSpace* cpSpaceNew ( ) ;
-FUNCTION: void cpSpaceDestroy ( cpSpace* space ) ;
-FUNCTION: void cpSpaceFree ( cpSpace* space ) ;
-FUNCTION: void cpSpaceFreeChildren ( cpSpace* space ) ;
-FUNCTION: void cpSpaceSetDefaultCollisionHandler (
- cpSpace* space,
- cpCollisionBeginFunc begin,
- cpCollisionPreSolveFunc preSolve,
- cpCollisionPostSolveFunc postSolve,
- cpCollisionSeparateFunc separate,
- void* data ) ;
-FUNCTION: void cpSpaceAddCollisionHandler (
- cpSpace* space,
- cpCollisionType a,
- cpCollisionType b,
- cpCollisionBeginFunc begin,
- cpCollisionPreSolveFunc preSolve,
- cpCollisionPostSolveFunc postSolve,
- cpCollisionSeparateFunc separate,
- void* data ) ;
-FUNCTION: void cpSpaceRemoveCollisionHandler ( cpSpace* space, cpCollisionType a, cpCollisionType b ) ;
-FUNCTION: cpShape* cpSpaceAddShape ( cpSpace* space, cpShape* shape ) ;
-FUNCTION: cpShape* cpSpaceAddStaticShape ( cpSpace* space, cpShape* shape ) ;
-FUNCTION: cpBody* cpSpaceAddBody ( cpSpace* space, cpBody* body ) ;
-FUNCTION: cpConstraint* cpSpaceAddConstraint ( cpSpace* space, cpConstraint* constraint ) ;
-FUNCTION: void cpSpaceRemoveShape ( cpSpace* space, cpShape* shape ) ;
-FUNCTION: void cpSpaceRemoveStaticShape ( cpSpace* space, cpShape* shape ) ;
-FUNCTION: void cpSpaceRemoveBody ( cpSpace* space, cpBody* body ) ;
-FUNCTION: void cpSpaceRemoveConstraint ( cpSpace* space, cpConstraint* constraint ) ;
-CALLBACK: void cpPostStepFunc ( cpSpace* space, void* obj, void* data ) ;
-FUNCTION: void cpSpaceAddPostStepCallback ( cpSpace* space, cpPostStepFunc func, void* obj, void* data ) ;
-CALLBACK: void cpSpacePointQueryFunc ( cpShape* shape, void* data ) ;
-FUNCTION: void cpSpacePointQuery ( cpSpace* space, cpVect point, cpLayers layers, cpGroup group, cpSpacePointQueryFunc func, void* data ) ;
-FUNCTION: cpShape* cpSpacePointQueryFirst ( cpSpace* space, cpVect point, cpLayers layers, cpGroup group ) ;
-CALLBACK: void cpSpaceSegmentQueryFunc ( cpShape* shape, cpFloat t, cpVect n, void* data ) ;
-FUNCTION: int cpSpaceSegmentQuery ( cpSpace* space, cpVect start, cpVect end, cpLayers layers, cpGroup group, cpSpaceSegmentQueryFunc func, void* data ) ;
-FUNCTION: cpShape* cpSpaceSegmentQueryFirst ( cpSpace* space, cpVect start, cpVect end, cpLayers layers, cpGroup group, cpSegmentQueryInfo* out ) ;
-CALLBACK: void cpSpaceBBQueryFunc ( cpShape* shape, void* data ) ;
-FUNCTION: void cpSpaceBBQuery ( cpSpace* space, cpBB bb, cpLayers layers, cpGroup group, cpSpaceBBQueryFunc func, void* data ) ;
-CALLBACK: void cpSpaceBodyIterator ( cpBody* body, void* data ) ;
-FUNCTION: void cpSpaceEachBody ( cpSpace* space, cpSpaceBodyIterator func, void* data ) ;
-FUNCTION: void cpSpaceResizeStaticHash ( cpSpace* space, cpFloat dim, int count ) ;
-FUNCTION: void cpSpaceResizeActiveHash ( cpSpace* space, cpFloat dim, int count ) ;
-FUNCTION: void cpSpaceRehashStatic ( cpSpace* space ) ;
-FUNCTION: void cpSpaceStep ( cpSpace* space, cpFloat dt ) ;
-
-! chipmunk.h
-FUNCTION: void cpInitChipmunk ( ) ;
-FUNCTION: cpFloat cpMomentForCircle ( cpFloat m, cpFloat r1, cpFloat r2, cpVect offset ) ;
-FUNCTION: cpFloat cpMomentForSegment ( cpFloat m, cpVect a, cpVect b ) ;
-FUNCTION: cpFloat cpMomentForPoly ( cpFloat m, int numVerts, cpVect* verts, cpVect offset ) ;
-
! Copyright (C) 2010 Erik Charlebois
! See http:// factorcode.org/license.txt for BSD license.
-USING: accessors chipmunk classes.struct game.loop game.worlds gpu
-gpu.util.wasd kernel literals locals math method-chains opengl.gl
-random sequences specialized-arrays
-specialized-arrays.instances.alien.c-types.void* ui.gadgets.worlds
+USING: accessors alien chipmunk.ffi classes.struct game.worlds kernel
+locals math method-chains opengl.gl random sequences specialized-arrays
+specialized-arrays.instances.alien.c-types.void* ui ui.gadgets.worlds
ui.pixel-formats ;
IN: chipmunk.demo
x bitnot 7 bitand neg shift 1 bitand 1 = ;
:: make-ball ( x y -- shape )
- cpBodyAlloc 1.0 NAN: 0 cpBodyInit cpBody memory>struct
+ cpBodyAlloc 1.0 NAN: 0 cpBodyInit
x y cpv >>p :> body
- cpCircleShapeAlloc body 0.95 0 0 cpv cpCircleShapeInit cpCircleShape memory>struct
- [ shape>> 0 >>e ] [ shape>> 0 >>u ] bi drop ;
+ cpCircleShapeAlloc body 0.95 0 0 cpv cpCircleShapeInit
+ dup shape>>
+ 0 >>e
+ 0 >>u
+ drop ;
-TUPLE: chipmunk-world < wasd-world
+TUPLE: chipmunk-world < game-world
space ;
AFTER: chipmunk-world tick-game-world
3 glPointSize
0 0 0 glColor3f
GL_POINTS glBegin
- space bodies>> cpArray memory>struct
+ space bodies>>
[ num>> ] [ arr>> swap <direct-void*-array> ] bi [
cpBody memory>struct p>> [ x>> ] [ y>> ] bi glVertex2f
] each
2 glPointSize
1 0 0 glColor3f
GL_POINTS glBegin
- space arbiters>> cpArray memory>struct
+ space arbiters>>
[ num>> ] [ arr>> swap <direct-void*-array> ] bi [
cpArbiter memory>struct
- [ numContacts>> ] [ contacts>> swap <direct-cpContact-array> ] bi [
+ [ numContacts>> ] [ contacts>> >c-ptr swap <direct-cpContact-array> ] bi [
p>> [ x>> ] [ y>> ] bi glVertex2f
] each
] each
M:: chipmunk-world begin-game-world ( world -- )
cpInitChipmunk
- init-gpu
- world { -0.2 0.13 0.1 } 1.1 0.2 set-wasd-view drop
- cpSpaceAlloc cpSpaceInit cpSpace memory>struct :> space
+ cpSpaceAlloc cpSpaceInit :> space
world space >>space drop
space 2.0 10000 cpSpaceResizeActiveHash
x image-width 2 / - 0.05 0.0 1.0 uniform-random-float * + 2 *
image-height 2 / y - 0.05 0.0 1.0 uniform-random-float * + 2 *
make-ball :> shape
- space shape body>> cpSpaceAddBody drop
+ space shape shape>> body>> cpSpaceAddBody drop
space shape cpSpaceAddShape drop
] when
] each
] each
- space cpBodyAlloc NAN: 0 dup cpBodyInit cpSpaceAddBody cpBody memory>struct :> body
+ space cpBodyAlloc NAN: 0 dup cpBodyInit cpSpaceAddBody :> body
body -1000 -10 cpv >>p drop
body 400 0 cpv >>v drop
- space cpCircleShapeAlloc body 8 0 0 cpv cpCircleShapeInit cpSpaceAddShape cpCircleShape memory>struct :> shape
- shape
- [ shape>> 0 >>e drop ]
- [ shape>> 0 >>u drop ] bi ;
+ space cpCircleShapeAlloc [ body 8 0 0 cpv cpCircleShapeInit cpSpaceAddShape drop ] keep
+ :> shape
+ shape shape>>
+ 0 >>e
+ 0 >>u
+ drop ;
M: chipmunk-world end-game-world
space>>
[ cpSpaceFreeChildren ]
[ cpSpaceFree ] bi ;
-M: chipmunk-world wasd-movement-speed drop 1/160. ;
-M: chipmunk-world wasd-near-plane drop 1/32. ;
-M: chipmunk-world wasd-far-plane drop 256.0 ;
-
-GAME: chipmunk-demo {
- { world-class chipmunk-world }
- { title "Chipmunk Physics Demo" }
- { pixel-format-attributes {
- windowed
- double-buffered
- T{ depth-bits { value 24 } }
- } }
- { grab-input? t }
- { use-game-input? t }
- { pref-dim { 640 480 } }
- { tick-interval-micros $[ 60 fps ] }
- } ;
+: chipmunk-demo ( -- )
+ [
+ f
+ T{ game-attributes
+ { world-class chipmunk-world }
+ { title "Chipmunk Physics Demo" }
+ { pixel-format-attributes
+ { windowed double-buffered }
+ }
+ { pref-dim { 640 480 } }
+ { tick-interval-micros 16666 }
+ }
+ clone
+ open-window
+ ] with-ui ;
+
+MAIN: chipmunk-demo
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois
+! See http:// factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types alien.syntax classes.struct combinators
+combinators.short-circuit kernel math math.order sequences
+typed specialized-arrays locals system alien.libraries ;
+SPECIALIZED-ARRAY: void*
+IN: chipmunk.ffi
+
+<<
+"chipmunk" {
+ { [ os windows? ] [ "chipmunk.dll" ] }
+ { [ os macosx? ] [ "libchipmunk.dylib" ] }
+ { [ os unix? ] [ "libchipmunk.so" ] }
+} cond "cdecl" add-library
+
+"chipmunk" deploy-library
+>>
+LIBRARY: chipmunk
+
+! chipmunk_types.h
+TYPEDEF: double cpFloat
+STRUCT: cpVect
+ { x cpFloat }
+ { y cpFloat } ;
+SPECIALIZED-ARRAY: cpVect
+
+TYPEDEF: uint cpHashValue
+TYPEDEF: void* cpDataPointer
+TYPEDEF: uint cpCollisionType
+TYPEDEF: uint cpLayers
+TYPEDEF: uint cpGroup
+
+CONSTANT: CP_NO_GROUP 0
+CONSTANT: CP_ALL_LAYERS HEX: ffffffff
+
+! cpVect.h
+TYPED: cpv ( x y -- v: cpVect )
+ cpVect <struct-boa> ; inline
+
+TYPED: cpvzero ( -- v: cpVect )
+ 0.0 0.0 cpv ; inline
+
+FUNCTION: cpFloat cpvlength ( cpVect v ) ;
+FUNCTION: cpVect cpvslerp ( cpVect v1, cpVect v2, cpFloat t ) ;
+FUNCTION: cpVect cpvslerpconst ( cpVect v1, cpVect v2, cpFloat a ) ;
+FUNCTION: cpVect cpvforangle ( cpFloat a ) ;
+FUNCTION: cpFloat cpvtoangle ( cpVect v ) ;
+FUNCTION: c-string cpvstr ( cpVect v ) ;
+
+TYPED: cpvadd ( v1: cpVect v2: cpVect -- v3: cpVect )
+ [ [ x>> ] bi@ + ]
+ [ [ y>> ] bi@ + ] 2bi cpv ; inline
+
+TYPED: cpvneg ( v1: cpVect -- v2: cpVect )
+ [ x>> ] [ y>> ] bi [ neg ] bi@ cpv ; inline
+
+TYPED: cpvsub ( v1: cpVect v2: cpVect -- v3: cpVect )
+ [ [ x>> ] bi@ - ]
+ [ [ y>> ] bi@ - ] 2bi cpv ; inline
+
+TYPED: cpvmult ( v1: cpVect s -- v2: cpVect )
+ [ swap x>> * ]
+ [ swap y>> * ] 2bi cpv ; inline
+
+TYPED: cpvdot ( v1: cpVect v2: cpVect -- s )
+ [ [ x>> ] bi@ * ]
+ [ [ y>> ] bi@ * ] 2bi + ; inline
+
+TYPED: cpvcross ( v1: cpVect v2: cpVect -- s )
+ [ [ x>> ] [ y>> ] bi* * ]
+ [ [ y>> ] [ x>> ] bi* * ] 2bi - ; inline
+
+TYPED: cpvperp ( v1: cpVect -- v2: cpVect )
+ [ y>> neg ] [ x>> ] bi cpv ; inline
+
+TYPED: cpvrperp ( v1: cpVect -- v2: cpVect )
+ [ y>> ] [ x>> neg ] bi cpv ; inline
+
+TYPED: cpvproject ( v1: cpVect v2: cpVect -- v3: cpVect )
+ [ nip ]
+ [ cpvdot ]
+ [ nip dup cpvdot ]
+ 2tri / cpvmult ; inline
+
+TYPED: cpvrotate ( v1: cpVect v2: cpVect -- v3: cpVect )
+ [
+ [ [ x>> ] bi@ * ]
+ [ [ y>> ] bi@ * ] 2bi -
+ ]
+ [
+ [ [ x>> ] [ y>> ] bi* * ]
+ [ [ y>> ] [ x>> ] bi* * ] 2bi +
+ ] 2bi cpv ; inline
+
+TYPED: cpvunrotate ( v1: cpVect v2: cpVect -- v3: cpVect )
+ [
+ [ [ x>> ] bi@ * ]
+ [ [ y>> ] bi@ * ] 2bi +
+ ]
+ [
+ [ [ y>> ] [ x>> ] bi* * ]
+ [ [ x>> ] [ y>> ] bi* * ] 2bi -
+ ] 2bi cpv ; inline
+
+TYPED: cpvlengthsq ( v: cpVect -- s )
+ dup cpvdot ; inline
+
+TYPED: cpvlerp ( v1: cpVect v2: cpVect s -- v3: cpVect )
+ [ nip 1.0 swap - cpvmult ]
+ [ cpvmult nip ] 3bi cpvadd ; inline
+
+TYPED: cpvnormalize ( v1: cpVect -- v2: cpVect )
+ dup cpvlength 1.0 swap / cpvmult ; inline
+
+TYPED: cpvnormalize_safe ( v1: cpVect -- v2: cpVect )
+ dup [ x>> 0.0 = ] [ y>> 0.0 = ] bi and
+ [ drop cpvzero ]
+ [ cpvnormalize ] if ; inline
+
+TYPED: cpvclamp ( v1: cpVect len -- v2: cpVect )
+ 2dup
+ [ dup cpvdot ]
+ [ sq ] 2bi* >
+ [ [ cpvnormalize ] dip cpvmult ]
+ [ drop ] if ; inline
+
+TYPED: cpvlerpconst ( v1: cpVect v2: cpVect d -- v3: cpVect )
+ [ 2drop ]
+ [ [ swap cpvsub ] dip cpvclamp ] 3bi cpvadd ; inline
+
+TYPED: cpvdist ( v1: cpVect v2: cpVect -- dist )
+ cpvsub cpvlength ; inline
+
+TYPED: cpvdistsq ( v1: cpVect v2: cpVect -- distsq )
+ cpvsub cpvlengthsq ; inline
+
+TYPED: cpvnear ( v1: cpVect v2: cpVect dist -- ? )
+ [ cpvdistsq ] dip sq < ; inline
+
+! cpBB.h
+STRUCT: cpBB
+ { l cpFloat }
+ { b cpFloat }
+ { r cpFloat }
+ { t cpFloat } ;
+
+TYPED: cpBBNew ( l b r t -- cpbb: cpBB )
+ cpBB <struct-boa> ; inline
+
+TYPED: cpBBintersects ( a: cpBB b: cpBB -- ? )
+ {
+ [ [ l>> ] [ r>> ] bi* <= ]
+ [ [ r>> ] [ l>> ] bi* > ]
+ [ [ b>> ] [ t>> ] bi* <= ]
+ [ [ t>> ] [ b>> ] bi* > ]
+ } 2&& ; inline
+
+TYPED: cpBBcontainsBB ( bb: cpBB other: cpBB -- ? )
+ {
+ [ [ l>> ] bi@ < ]
+ [ [ r>> ] bi@ > ]
+ [ [ b>> ] bi@ < ]
+ [ [ t>> ] bi@ > ]
+ } 2&& ; inline
+
+TYPED: cpBBcontainsVect ( bb: cpBB v: cpVect -- ? )
+ {
+ [ [ l>> ] [ x>> ] bi* < ]
+ [ [ r>> ] [ x>> ] bi* > ]
+ [ [ b>> ] [ y>> ] bi* < ]
+ [ [ t>> ] [ y>> ] bi* > ]
+ } 2&& ; inline
+
+TYPED: cpBBmerge ( a: cpBB b: cpBB -- c: cpBB )
+ {
+ [ [ l>> ] bi@ min ]
+ [ [ b>> ] bi@ min ]
+ [ [ r>> ] bi@ max ]
+ [ [ t>> ] bi@ max ]
+ } 2cleave cpBBNew ; inline
+
+TYPED: cpBBexpand ( bb: cpBB v: cpVect -- b: cpBB )
+ {
+ [ [ l>> ] [ x>> ] bi* min ]
+ [ [ b>> ] [ y>> ] bi* min ]
+ [ [ r>> ] [ x>> ] bi* max ]
+ [ [ t>> ] [ y>> ] bi* max ]
+ } 2cleave cpBBNew ; inline
+
+FUNCTION: cpVect cpBBClampVect ( cpBB bb, cpVect v ) ;
+FUNCTION: cpVect cpBBWrapVect ( cpBB bb, cpVect v ) ;
+
+! cpBody.h
+C-TYPE: cpBody
+CALLBACK: void cpBodyVelocityFunc ( cpBody* body, cpVect gravity, cpFloat damping, cpFloat dt ) ;
+CALLBACK: void cpBodyPositionFunc ( cpBody* body, cpFloat dt ) ;
+
+STRUCT: cpBody
+ { velocity_func cpBodyVelocityFunc }
+ { position_func cpBodyPositionFunc }
+ { m cpFloat }
+ { m_inv cpFloat }
+ { i cpFloat }
+ { i_inv cpFloat }
+ { p cpVect }
+ { v cpVect }
+ { f cpVect }
+ { a cpFloat }
+ { w cpFloat }
+ { t cpFloat }
+ { rot cpVect }
+ { data cpDataPointer }
+ { v_limit cpFloat }
+ { w_limit cpFloat }
+ { v_bias cpVect }
+ { w_bias cpFloat } ;
+
+FUNCTION: cpBody* cpBodyAlloc ( ) ;
+FUNCTION: cpBody* cpBodyInit ( cpBody* body, cpFloat m, cpFloat i ) ;
+FUNCTION: cpBody* cpBodyNew ( cpFloat m, cpFloat i ) ;
+FUNCTION: void cpBodyDestroy ( cpBody* body ) ;
+FUNCTION: void cpBodyFree ( cpBody* body ) ;
+FUNCTION: void cpBodySetMass ( cpBody* body, cpFloat m ) ;
+FUNCTION: void cpBodySetMoment ( cpBody* body, cpFloat i ) ;
+FUNCTION: void cpBodySetAngle ( cpBody* body, cpFloat a ) ;
+FUNCTION: void cpBodySlew ( cpBody* body, cpVect pos, cpFloat dt ) ;
+FUNCTION: void cpBodyUpdateVelocity ( cpBody* body, cpVect gravity, cpFloat damping, cpFloat dt ) ;
+FUNCTION: void cpBodyUpdatePosition ( cpBody* body, cpFloat dt ) ;
+
+TYPED: cpBodyLocal2World ( body: cpBody v: cpVect -- v2: cpVect )
+ [ drop p>> ]
+ [ swap rot>> cpvrotate ] 2bi cpvadd ; inline
+
+TYPED: cpBodyWorld2Local ( body: cpBody v: cpVect -- v2: cpVect )
+ [ swap p>> cpvsub ]
+ [ drop rot>> ] 2bi cpvunrotate ; inline
+
+TYPED: cpBodyApplyImpulse ( body: cpBody j: cpVect r: cpVect -- )
+ [
+ drop
+ [ drop dup v>> ]
+ [ swap m_inv>> cpvmult ] 2bi cpvadd >>v drop
+ ]
+ [
+ [ 2drop dup w_bias>> ]
+ [ swap cpvcross [ i_inv>> ] dip * ] 3bi + >>w_bias drop
+ ] 3bi ; inline
+
+FUNCTION: void cpBodyResetForces ( cpBody* body ) ;
+FUNCTION: void cpBodyApplyForce ( cpBody* body, cpVect f, cpVect r ) ;
+FUNCTION: void cpApplyDampedSpring ( cpBody* a, cpBody* b, cpVect anchr1, cpVect anchr2, cpFloat rlen, cpFloat k, cpFloat dmp, cpFloat dt ) ;
+
+! cpArray.h
+STRUCT: cpArray
+ { num int }
+ { max int }
+ { arr void** } ;
+
+CALLBACK: void cpArrayIter ( void* ptr, void* data ) ;
+
+FUNCTION: cpArray* cpArrayAlloc ( ) ;
+FUNCTION: cpArray* cpArrayInit ( cpArray* arr, int size ) ;
+FUNCTION: cpArray* cpArrayNew ( int size ) ;
+FUNCTION: void cpArrayDestroy ( cpArray* arr ) ;
+FUNCTION: void cpArrayFree ( cpArray* arr ) ;
+FUNCTION: void cpArrayPush ( cpArray* arr, void* object ) ;
+FUNCTION: void cpArrayDeleteIndex ( cpArray* arr, int idx ) ;
+FUNCTION: void cpArrayDeleteObj ( cpArray* arr, void* obj ) ;
+FUNCTION: void cpArrayEach ( cpArray* arr, cpArrayIter iterFunc, void* data ) ;
+FUNCTION: int cpArrayContains ( cpArray* arr, void* ptr ) ;
+
+! cpHashSet.h
+STRUCT: cpHashSetBin
+ { elt void* }
+ { hash cpHashValue }
+ { next cpHashSetBin* } ;
+
+CALLBACK: int cpHashSetEqlFunc ( void* ptr, void* elt ) ;
+CALLBACK: void* cpHashSetTransFunc ( void* ptr, void* data ) ;
+CALLBACK: void cpHashSetIterFunc ( void* elt, void* data ) ;
+CALLBACK: int cpHashSetFilterFunc ( void* elt, void* data ) ;
+
+STRUCT: cpHashSet
+ { entries int }
+ { size int }
+ { eql cpHashSetEqlFunc }
+ { trans cpHashSetTransFunc }
+ { default_value void* }
+ { table cpHashSetBin** } ;
+
+FUNCTION: void cpHashSetDestroy ( cpHashSet* set ) ;
+FUNCTION: void cpHashSetFree ( cpHashSet* set ) ;
+FUNCTION: cpHashSet* cpHashSetAlloc ( ) ;
+FUNCTION: cpHashSet* cpHashSetInit ( cpHashSet* set, int size, cpHashSetEqlFunc eqlFunc, cpHashSetTransFunc trans ) ;
+FUNCTION: cpHashSet* cpHashSetNew ( int size, cpHashSetEqlFunc eqlFunc, cpHashSetTransFunc trans ) ;
+FUNCTION: void* cpHashSetInsert ( cpHashSet* set, cpHashValue hash, void* ptr, void* data ) ;
+FUNCTION: void* cpHashSetRemove ( cpHashSet* set, cpHashValue hash, void* ptr ) ;
+FUNCTION: void* cpHashSetFind ( cpHashSet* set, cpHashValue hash, void* ptr ) ;
+FUNCTION: void cpHashSetEach ( cpHashSet* set, cpHashSetIterFunc func, void* data ) ;
+FUNCTION: void cpHashSetFilter ( cpHashSet* set, cpHashSetFilterFunc func, void* data ) ;
+
+! cpSpaceHash.h
+STRUCT: cpHandle
+ { obj void* }
+ { retain int }
+ { stamp int } ;
+
+STRUCT: cpSpaceHashBin
+ { handle cpHandle* }
+ { next cpSpaceHashBin* } ;
+
+CALLBACK: cpBB cpSpaceHashBBFunc ( void* obj ) ;
+
+STRUCT: cpSpaceHash
+ { numcells int }
+ { celldim cpFloat }
+ { bbfunc cpSpaceHashBBFunc }
+ { handleSet cpHashSet* }
+ { table cpSpaceHashBin** }
+ { bins cpSpaceHashBin* }
+ { stamp int } ;
+
+FUNCTION: cpSpaceHash* cpSpaceHashAlloc ( ) ;
+FUNCTION: cpSpaceHash* cpSpaceHashInit ( cpSpaceHash* hash, cpFloat celldim, int cells, cpSpaceHashBBFunc bbfunc ) ;
+FUNCTION: cpSpaceHash* cpSpaceHashNew ( cpFloat celldim, int cells, cpSpaceHashBBFunc bbfunc ) ;
+FUNCTION: void cpSpaceHashDestroy ( cpSpaceHash* hash ) ;
+FUNCTION: void cpSpaceHashFree ( cpSpaceHash* hash ) ;
+FUNCTION: void cpSpaceHashResize ( cpSpaceHash* hash, cpFloat celldim, int numcells ) ;
+FUNCTION: void cpSpaceHashInsert ( cpSpaceHash* hash, void* obj, cpHashValue id, cpBB bb ) ;
+FUNCTION: void cpSpaceHashRemove ( cpSpaceHash* hash, void* obj, cpHashValue id ) ;
+CALLBACK: void cpSpaceHashIterator ( void* obj, void* data ) ;
+FUNCTION: void cpSpaceHashEach ( cpSpaceHash* hash, cpSpaceHashIterator func, void* data ) ;
+FUNCTION: void cpSpaceHashRehash ( cpSpaceHash* hash ) ;
+FUNCTION: void cpSpaceHashRehashObject ( cpSpaceHash* hash, void* obj, cpHashValue id ) ;
+CALLBACK: void cpSpaceHashQueryFunc ( void* obj1, void* obj2, void* data ) ;
+FUNCTION: void cpSpaceHashPointQuery ( cpSpaceHash* hash, cpVect point, cpSpaceHashQueryFunc func, void* data ) ;
+FUNCTION: void cpSpaceHashQuery ( cpSpaceHash* hash, void* obj, cpBB bb, cpSpaceHashQueryFunc func, void* data ) ;
+FUNCTION: void cpSpaceHashQueryRehash ( cpSpaceHash* hash, cpSpaceHashQueryFunc func, void* data ) ;
+CALLBACK: cpFloat cpSpaceHashSegmentQueryFunc ( void* obj1, void* obj2, void* data ) ;
+FUNCTION: void cpSpaceHashSegmentQuery ( cpSpaceHash* hash, void* obj, cpVect a, cpVect b, cpFloat t_exit, cpSpaceHashSegmentQueryFunc func, void* data ) ;
+
+! cpShape.h
+C-TYPE: cpShape
+C-TYPE: cpShapeClass
+
+STRUCT: cpSegmentQueryInfo
+ { shape cpShape* }
+ { t cpFloat }
+ { n cpVect } ;
+
+C-ENUM:
+ CP_CIRCLE_SHAPE
+ CP_SEGMENT_SHAPE
+ CP_POLY_SHAPE
+ CP_NUM_SHAPES ;
+TYPEDEF: int cpShapeType
+
+CALLBACK: cpBB cacheData_cb ( cpShape* shape, cpVect p, cpVect rot ) ;
+CALLBACK: void destroy_cb ( cpShape* shape ) ;
+CALLBACK: int pointQuery_cb ( cpShape* shape, cpVect p ) ;
+CALLBACK: void segmentQuery_cb ( cpShape* shape, cpVect a, cpVect b, cpSegmentQueryInfo* info ) ;
+
+STRUCT: cpShapeClass
+ { type cpShapeType }
+ { cacheData cacheData_cb }
+ { destroy destroy_cb }
+ { pointQuery pointQuery_cb }
+ { segmentQuery segmentQuery_cb } ;
+
+STRUCT: cpShape
+ { klass cpShapeClass* }
+ { body cpBody* }
+ { bb cpBB }
+ { sensor int }
+ { e cpFloat }
+ { u cpFloat }
+ { surface_v cpVect }
+ { data cpDataPointer }
+ { collision_type cpCollisionType }
+ { group cpGroup }
+ { layers cpLayers }
+ { hashid cpHashValue } ;
+
+FUNCTION: cpShape* cpShapeInit ( cpShape* shape, cpShapeClass* klass, cpBody* body ) ;
+FUNCTION: void cpShapeDestroy ( cpShape* shape ) ;
+FUNCTION: void cpShapeFree ( cpShape* shape ) ;
+FUNCTION: cpBB cpShapeCacheBB ( cpShape* shape ) ;
+FUNCTION: int cpShapePointQuery ( cpShape* shape, cpVect p ) ;
+
+STRUCT: cpCircleShape
+ { shape cpShape }
+ { c cpVect }
+ { r cpFloat }
+ { tc cpVect } ;
+
+FUNCTION: cpCircleShape* cpCircleShapeAlloc ( ) ;
+FUNCTION: cpCircleShape* cpCircleShapeInit ( cpCircleShape* circle, cpBody* body, cpFloat radius, cpVect offset ) ;
+FUNCTION: cpShape* cpCircleShapeNew ( cpBody* body, cpFloat radius, cpVect offset ) ;
+
+STRUCT: cpSegmentShape
+ { shape cpShape }
+ { a cpVect }
+ { b cpVect }
+ { n cpVect }
+ { r cpFloat }
+ { ta cpVect }
+ { tb cpVect }
+ { tn cpVect } ;
+
+FUNCTION: cpSegmentShape* cpSegmentShapeAlloc ( ) ;
+FUNCTION: cpSegmentShape* cpSegmentShapeInit ( cpSegmentShape* seg, cpBody* body, cpVect a, cpVect b, cpFloat radius ) ;
+FUNCTION: cpShape* cpSegmentShapeNew ( cpBody* body, cpVect a, cpVect b, cpFloat radius ) ;
+FUNCTION: void cpResetShapeIdCounter ( ) ;
+FUNCTION: void cpSegmentQueryInfoPrint ( cpSegmentQueryInfo* info ) ;
+FUNCTION: int cpShapeSegmentQuery ( cpShape* shape, cpVect a, cpVect b, cpSegmentQueryInfo* info ) ;
+
+TYPED: cpSegmentQueryHitPoint ( start: cpVect end: cpVect info: cpSegmentQueryInfo -- hit-point: cpVect )
+ t>> cpvlerp ; inline
+
+TYPED: cpSegmentQueryHitDist ( start: cpVect end: cpVect info: cpSegmentQueryInfo -- hit-dist )
+ t>> [ cpvdist ] dip * ; inline
+
+! cpPolyShape.h
+STRUCT: cpPolyShapeAxis
+ { n cpVect }
+ { d cpFloat } ;
+SPECIALIZED-ARRAY: cpPolyShapeAxis
+
+STRUCT: cpPolyShape
+ { shape cpShape }
+ { numVerts int }
+ { verts cpVect* }
+ { axes cpPolyShapeAxis* }
+ { tVerts cpVect* }
+ { tAxes cpPolyShapeAxis* } ;
+
+FUNCTION: cpPolyShape* cpPolyShapeAlloc ( ) ;
+FUNCTION: cpPolyShape* cpPolyShapeInit ( cpPolyShape* poly, cpBody* body, int numVerts, cpVect* verts, cpVect offset ) ;
+FUNCTION: cpShape* cpPolyShapeNew ( cpBody* body, int numVerts, cpVect* verts, cpVect offset ) ;
+FUNCTION: int cpPolyValidate ( cpVect* verts, int numVerts ) ;
+FUNCTION: int cpPolyShapeGetNumVerts ( cpShape* shape ) ;
+FUNCTION: cpVect cpPolyShapeGetVert ( cpShape* shape, int idx ) ;
+
+TYPED: cpPolyShapeValueOnAxis ( poly: cpPolyShape n: cpVect d -- min-dist )
+ swap rot [ numVerts>> ] [ tVerts>> swap <direct-cpVect-array> ] bi swap
+ [ cpvdot ] curry [ min ] reduce swap - ; inline
+
+TYPED: cpPolyShapeContainsVert ( poly: cpPolyShape v: cpVect -- ? )
+ swap [ numVerts>> ] [ tAxes>> swap <direct-cpPolyShapeAxis-array> ] bi swap
+ [
+ [ [ n>> ] dip cpvdot ] [ drop d>> ] 2bi -
+ ] curry [ max ] reduce 0.0 <= ; inline
+
+TYPED: cpPolyShapeContainsVertPartial ( poly: cpPolyShape v: cpVect n: cpVect -- ? )
+ rot [ numVerts>> ] [ tAxes>> swap <direct-cpPolyShapeAxis-array> ] bi -rot
+ [| axis v n |
+ axis n>> n cpvdot 0.0 < 0
+ [ 0.0 ]
+ [ axis n>> v cpvdot axis d>> - ]
+ if
+ ] 2curry [ max ] reduce 0.0 <= ; inline
+
+! cpArbiter.h
+C-TYPE: cpArbiter
+C-TYPE: cpSpace
+C-TYPE: cpCollisionHandler
+
+STRUCT: cpContact
+ { p cpVect }
+ { n cpVect }
+ { dist cpFloat }
+ { r1 cpVect }
+ { r2 cpVect }
+ { nMass cpFloat }
+ { tMass cpFloat }
+ { bounce cpFloat }
+ { jnAcc cpFloat }
+ { jtAcc cpFloat }
+ { jBias cpFloat }
+ { bias cpFloat }
+ { hash cpHashValue } ;
+
+FUNCTION: cpContact* cpContactInit ( cpContact* con, cpVect p, cpVect n, cpFloat dist, cpHashValue hash ) ;
+
+C-ENUM:
+ cpArbiterStateNormal
+ cpArbiterStateFirstColl
+ cpArbiterStateIgnore ;
+TYPEDEF: int cpArbiterState
+
+STRUCT: cpArbiter
+ { numContacts int }
+ { contacts cpContact* }
+ { a cpShape* }
+ { b cpShape* }
+ { e cpFloat }
+ { u cpFloat }
+ { surface_vr cpVect }
+ { stamp int }
+ { handler cpCollisionHandler* }
+ { swappedColl char }
+ { state char } ;
+
+FUNCTION: cpArbiter* cpArbiterAlloc ( ) ;
+FUNCTION: cpArbiter* cpArbiterInit ( cpArbiter* arb, cpShape* a, cpShape* b ) ;
+FUNCTION: cpArbiter* cpArbiterNew ( cpShape* a, cpShape* b ) ;
+FUNCTION: void cpArbiterDestroy ( cpArbiter* arb ) ;
+FUNCTION: void cpArbiterFree ( cpArbiter* arb ) ;
+FUNCTION: void cpArbiterUpdate ( cpArbiter* arb, cpContact* contacts, int numContacts, cpCollisionHandler* handler, cpShape* a, cpShape* b ) ;
+FUNCTION: void cpArbiterPreStep ( cpArbiter* arb, cpFloat dt_inv ) ;
+FUNCTION: void cpArbiterApplyCachedImpulse ( cpArbiter* arb ) ;
+FUNCTION: void cpArbiterApplyImpulse ( cpArbiter* arb, cpFloat eCoef ) ;
+FUNCTION: cpVect cpArbiterTotalImpulse ( cpArbiter* arb ) ;
+FUNCTION: cpVect cpArbiterTotalImpulseWithFriction ( cpArbiter* arb ) ;
+FUNCTION: void cpArbiterIgnore ( cpArbiter* arb ) ;
+
+TYPED: cpArbiterGetShapes ( arb: cpArbiter -- a: cpShape b: cpShape )
+ dup swappedColl>> 0 = [
+ [ a>> ] [ b>> ] bi
+ ] [
+ [ b>> ] [ a>> ] bi
+ ] if ; inline
+
+TYPED: cpArbiterIsFirstContact ( arb: cpArbiter -- ? )
+ state>> cpArbiterStateFirstColl = ; inline
+
+TYPED: cpArbiterGetNormal ( arb: cpArbiter i -- n: cpVect )
+ [
+ swap
+ [ numContacts>> ]
+ [ contacts>> swap <direct-void*-array> ] bi nth cpContact memory>struct n>>
+ ]
+ [
+ drop swappedColl>> 0 = [ ] [ cpvneg ] if
+ ] 2bi ; inline
+
+TYPED: cpArbiterGetPoint ( arb: cpArbiter i -- p: cpVect )
+ swap
+ [ numContacts>> ]
+ [ contacts>> swap <direct-void*-array> ] bi
+ nth cpContact memory>struct p>> ; inline
+
+! cpCollision.h
+FUNCTION: int cpCollideShapes ( cpShape* a, cpShape* b, cpContact** arr ) ;
+
+! cpConstraint.h
+
+C-TYPE: cpConstraintClass
+C-TYPE: cpConstraint
+
+CALLBACK: void cpConstraintPreStepFunction ( cpConstraint* constraint, cpFloat dt, cpFloat dt_inv ) ;
+CALLBACK: void cpConstraintApplyImpulseFunction ( cpConstraint* constraint ) ;
+CALLBACK: cpFloat cpConstraintGetImpulseFunction ( cpConstraint* constraint ) ;
+
+STRUCT: cpConstraintClass
+ { preStep cpConstraintPreStepFunction }
+ { applyImpulse cpConstraintApplyImpulseFunction }
+ { getImpulse cpConstraintGetImpulseFunction } ;
+
+STRUCT: cpConstraint
+ { klass cpConstraintClass* }
+ { a cpBody* }
+ { b cpBody* }
+ { maxForce cpFloat }
+ { biasCoef cpFloat }
+ { maxBias cpFloat }
+ { data cpDataPointer } ;
+
+FUNCTION: void cpConstraintDestroy ( cpConstraint* constraint ) ;
+FUNCTION: void cpConstraintFree ( cpConstraint* constraint ) ;
+FUNCTION: void cpConstraintCheckCast ( cpConstraint* constraint, cpConstraintClass* klass ) ;
+
+! cpPinJoint.h
+FUNCTION: cpConstraintClass* cpPinJointGetClass ( ) ;
+
+STRUCT: cpPinJoint
+ { constraint cpConstraint }
+ { anchr1 cpVect }
+ { anchr2 cpVect }
+ { dist cpFloat }
+ { r1 cpVect }
+ { r2 cpVect }
+ { n cpVect }
+ { nMass cpFloat }
+ { jnAcc cpFloat }
+ { jnMax cpFloat }
+ { bias cpFloat } ;
+
+FUNCTION: cpPinJoint* cpPinJointAlloc ( ) ;
+FUNCTION: cpPinJoint* cpPinJointInit ( cpPinJoint* joint, cpBody* a, cpBody* b, cpVect anchr1, cpVect anchr2 ) ;
+FUNCTION: cpConstraint* cpPinJointNew ( cpBody* a, cpBody* b, cpVect anchr1, cpVect anchr2 ) ;
+
+! cpSlideJoint.h
+FUNCTION: cpConstraintClass* cpSlideJointGetClass ( ) ;
+
+STRUCT: cpSlideJoint
+ { constraint cpConstraint }
+ { anchr1 cpVect }
+ { anchr2 cpVect }
+ { min cpFloat }
+ { max cpFloat }
+ { r1 cpVect }
+ { r2 cpVect }
+ { n cpVect }
+ { nMass cpFloat }
+ { jnAcc cpFloat }
+ { jnMax cpFloat }
+ { bias cpFloat } ;
+
+FUNCTION: cpSlideJoint* cpSlideJointAlloc ( ) ;
+FUNCTION: cpSlideJoint* cpSlideJointInit ( cpSlideJoint* joint, cpBody* a, cpBody* b, cpVect anchr1, cpVect anchr2, cpFloat min, cpFloat max ) ;
+FUNCTION: cpConstraint* cpSlideJointNew ( cpBody* a, cpBody* b, cpVect anchr1, cpVect anchr2, cpFloat min, cpFloat max ) ;
+
+! cpPivotJoint.h
+FUNCTION: cpConstraintClass* cpPivotJointGetClass ( ) ;
+
+STRUCT: cpPivotJoint
+ { constraint cpConstraint }
+ { anchr1 cpVect }
+ { anchr2 cpVect }
+ { r1 cpVect }
+ { r2 cpVect }
+ { k1 cpVect }
+ { k2 cpVect }
+ { jAcc cpVect }
+ { jMaxLen cpFloat }
+ { bias cpVect } ;
+
+FUNCTION: cpPivotJoint* cpPivotJointAlloc ( ) ;
+FUNCTION: cpPivotJoint* cpPivotJointInit ( cpPivotJoint* joint, cpBody* a, cpBody* b, cpVect anchr1, cpVect anchr2 ) ;
+FUNCTION: cpConstraint* cpPivotJointNew ( cpBody* a, cpBody* b, cpVect pivot ) ;
+FUNCTION: cpConstraint* cpPivotJointNew2 ( cpBody* a, cpBody* b, cpVect anchr1, cpVect anchr2 ) ;
+
+! cpGrooveJoint.h
+FUNCTION: cpConstraintClass* cpGrooveJointGetClass ( ) ;
+
+STRUCT: cpGrooveJoint
+ { constraint cpConstraint }
+ { grv_n cpVect }
+ { grv_a cpVect }
+ { grv_b cpVect }
+ { anchr2 cpVect }
+ { grv_tn cpVect }
+ { clamp cpFloat }
+ { r1 cpVect }
+ { r2 cpVect }
+ { k1 cpVect }
+ { k2 cpVect }
+ { jAcc cpVect }
+ { jMaxLen cpFloat }
+ { bias cpVect } ;
+
+FUNCTION: cpGrooveJoint* cpGrooveJointAlloc ( ) ;
+FUNCTION: cpGrooveJoint* cpGrooveJointInit ( cpGrooveJoint* joint, cpBody* a, cpBody* b, cpVect groove_a, cpVect groove_b, cpVect anchr2 ) ;
+FUNCTION: cpConstraint* cpGrooveJointNew ( cpBody* a, cpBody* b, cpVect groove_a, cpVect groove_b, cpVect anchr2 ) ;
+
+! cpDampedSpring.h
+CALLBACK: cpFloat cpDampedSpringForceFunc ( cpConstraint* spring, cpFloat dist ) ;
+FUNCTION: cpConstraintClass* cpDampedSpringGetClass ( ) ;
+
+STRUCT: cpDampedSpring
+ { constraint cpConstraint }
+ { anchr1 cpVect }
+ { anchr2 cpVect }
+ { restLength cpFloat }
+ { stiffness cpFloat }
+ { damping cpFloat }
+ { springForceFunc cpDampedSpringForceFunc }
+ { dt cpFloat }
+ { target_vrn cpFloat }
+ { r1 cpVect }
+ { r2 cpVect }
+ { nMass cpFloat }
+ { n cpVect } ;
+
+FUNCTION: cpDampedSpring* cpDampedSpringAlloc ( ) ;
+FUNCTION: cpDampedSpring* cpDampedSpringInit ( cpDampedSpring* joint, cpBody* a, cpBody* b, cpVect anchr1, cpVect anchr2, cpFloat restLength, cpFloat stiffness, cpFloat damping ) ;
+FUNCTION: cpConstraint* cpDampedSpringNew ( cpBody* a, cpBody* b, cpVect anchr1, cpVect anchr2, cpFloat restLength, cpFloat stiffness, cpFloat damping ) ;
+
+! cpDampedRotarySpring.h
+CALLBACK: cpFloat cpDampedRotarySpringTorqueFunc ( cpConstraint* spring, cpFloat relativeAngle ) ;
+FUNCTION: cpConstraintClass* cpDampedRotarySpringGetClass ( ) ;
+
+STRUCT: cpDampedRotarySpring
+ { constraint cpConstraint }
+ { restAngle cpFloat }
+ { stiffness cpFloat }
+ { damping cpFloat }
+ { springTorqueFunc cpDampedRotarySpringTorqueFunc }
+ { dt cpFloat }
+ { target_wrn cpFloat }
+ { iSum cpFloat } ;
+
+FUNCTION: cpDampedRotarySpring* cpDampedRotarySpringAlloc ( ) ;
+FUNCTION: cpDampedRotarySpring* cpDampedRotarySpringInit ( cpDampedRotarySpring* joint, cpBody* a, cpBody* b, cpFloat restAngle, cpFloat stiffness, cpFloat damping ) ;
+FUNCTION: cpConstraint* cpDampedRotarySpringNew ( cpBody* a, cpBody* b, cpFloat restAngle, cpFloat stiffness, cpFloat damping ) ;
+
+! cpRotaryLimitJoint.h
+FUNCTION: cpConstraintClass* cpRotaryLimitJointGetClass ( ) ;
+
+STRUCT: cpRotaryLimitJoint
+ { constraint cpConstraint }
+ { min cpFloat }
+ { max cpFloat }
+ { iSum cpFloat }
+ { bias cpFloat }
+ { jAcc cpFloat }
+ { jMax cpFloat } ;
+
+FUNCTION: cpRotaryLimitJoint* cpRotaryLimitJointAlloc ( ) ;
+FUNCTION: cpRotaryLimitJoint* cpRotaryLimitJointInit ( cpRotaryLimitJoint* joint, cpBody* a, cpBody* b, cpFloat min, cpFloat max ) ;
+FUNCTION: cpConstraint* cpRotaryLimitJointNew ( cpBody* a, cpBody* b, cpFloat min, cpFloat max ) ;
+
+! cpRatchetJoint.h
+FUNCTION: cpConstraintClass* cpRatchetJointGetClass ( ) ;
+
+STRUCT: cpRatchetJoint
+ { constraint cpConstraint }
+ { angle cpFloat }
+ { phase cpFloat }
+ { ratchet cpFloat }
+ { iSum cpFloat }
+ { bias cpFloat }
+ { jAcc cpFloat }
+ { jMax cpFloat } ;
+
+FUNCTION: cpRatchetJoint* cpRatchetJointAlloc ( ) ;
+FUNCTION: cpRatchetJoint* cpRatchetJointInit ( cpRatchetJoint* joint, cpBody* a, cpBody* b, cpFloat phase, cpFloat ratchet ) ;
+FUNCTION: cpConstraint* cpRatchetJointNew ( cpBody* a, cpBody* b, cpFloat phase, cpFloat ratchet ) ;
+
+! cpGearJoint.h
+FUNCTION: cpConstraintClass* cpGearJointGetClass ( ) ;
+
+STRUCT: cpGearJoint
+ { constraint cpConstraint }
+ { phase cpFloat }
+ { ratio cpFloat }
+ { ratio_inv cpFloat }
+ { iSum cpFloat }
+ { bias cpFloat }
+ { jAcc cpFloat }
+ { jMax cpFloat } ;
+
+FUNCTION: cpGearJoint* cpGearJointAlloc ( ) ;
+FUNCTION: cpGearJoint* cpGearJointInit ( cpGearJoint* joint, cpBody* a, cpBody* b, cpFloat phase, cpFloat ratio ) ;
+FUNCTION: cpConstraint* cpGearJointNew ( cpBody* a, cpBody* b, cpFloat phase, cpFloat ratio ) ;
+FUNCTION: void cpGearJointSetRatio ( cpConstraint* constraint, cpFloat value ) ;
+
+! cpSimpleMotor.h
+FUNCTION: cpConstraintClass* cpSimpleMotorGetClass ( ) ;
+
+STRUCT: cpSimpleMotor
+ { constraint cpConstraint }
+ { rate cpFloat }
+ { iSum cpFloat }
+ { jAcc cpFloat }
+ { jMax cpFloat } ;
+
+FUNCTION: cpSimpleMotor* cpSimpleMotorAlloc ( ) ;
+FUNCTION: cpSimpleMotor* cpSimpleMotorInit ( cpSimpleMotor* joint, cpBody* a, cpBody* b, cpFloat rate ) ;
+FUNCTION: cpConstraint* cpSimpleMotorNew ( cpBody* a, cpBody* b, cpFloat rate ) ;
+
+! cpSpace.h
+C-TYPE: cpSpace
+
+CALLBACK: int cpCollisionBeginFunc ( cpArbiter* arb, cpSpace* space, void* data ) ;
+CALLBACK: int cpCollisionPreSolveFunc ( cpArbiter* arb, cpSpace* space, void* data ) ;
+CALLBACK: void cpCollisionPostSolveFunc ( cpArbiter* arb, cpSpace* space, void* data ) ;
+CALLBACK: void cpCollisionSeparateFunc ( cpArbiter* arb, cpSpace* space, void* data ) ;
+
+STRUCT: cpCollisionHandler
+ { a cpCollisionType }
+ { b cpCollisionType }
+ { begin cpCollisionBeginFunc }
+ { preSolve cpCollisionPreSolveFunc }
+ { postSolve cpCollisionPostSolveFunc }
+ { separate cpCollisionSeparateFunc }
+ { data void* } ;
+
+STRUCT: cpSpace
+ { iterations int }
+ { elasticIterations int }
+ { gravity cpVect }
+ { damping cpFloat }
+ { stamp int }
+ { staticShapes cpSpaceHash* }
+ { activeShapes cpSpaceHash* }
+ { bodies cpArray* }
+ { arbiters cpArray* }
+ { contactSet cpHashSet* }
+ { constraints cpArray* }
+ { collFuncSet cpHashSet* }
+ { defaultHandler cpCollisionHandler }
+ { postStepCallbacks cpHashSet* } ;
+
+FUNCTION: cpSpace* cpSpaceAlloc ( ) ;
+FUNCTION: cpSpace* cpSpaceInit ( cpSpace* space ) ;
+FUNCTION: cpSpace* cpSpaceNew ( ) ;
+FUNCTION: void cpSpaceDestroy ( cpSpace* space ) ;
+FUNCTION: void cpSpaceFree ( cpSpace* space ) ;
+FUNCTION: void cpSpaceFreeChildren ( cpSpace* space ) ;
+FUNCTION: void cpSpaceSetDefaultCollisionHandler (
+ cpSpace* space,
+ cpCollisionBeginFunc begin,
+ cpCollisionPreSolveFunc preSolve,
+ cpCollisionPostSolveFunc postSolve,
+ cpCollisionSeparateFunc separate,
+ void* data ) ;
+FUNCTION: void cpSpaceAddCollisionHandler (
+ cpSpace* space,
+ cpCollisionType a,
+ cpCollisionType b,
+ cpCollisionBeginFunc begin,
+ cpCollisionPreSolveFunc preSolve,
+ cpCollisionPostSolveFunc postSolve,
+ cpCollisionSeparateFunc separate,
+ void* data ) ;
+FUNCTION: void cpSpaceRemoveCollisionHandler ( cpSpace* space, cpCollisionType a, cpCollisionType b ) ;
+FUNCTION: cpShape* cpSpaceAddShape ( cpSpace* space, cpShape* shape ) ;
+FUNCTION: cpShape* cpSpaceAddStaticShape ( cpSpace* space, cpShape* shape ) ;
+FUNCTION: cpBody* cpSpaceAddBody ( cpSpace* space, cpBody* body ) ;
+FUNCTION: cpConstraint* cpSpaceAddConstraint ( cpSpace* space, cpConstraint* constraint ) ;
+FUNCTION: void cpSpaceRemoveShape ( cpSpace* space, cpShape* shape ) ;
+FUNCTION: void cpSpaceRemoveStaticShape ( cpSpace* space, cpShape* shape ) ;
+FUNCTION: void cpSpaceRemoveBody ( cpSpace* space, cpBody* body ) ;
+FUNCTION: void cpSpaceRemoveConstraint ( cpSpace* space, cpConstraint* constraint ) ;
+CALLBACK: void cpPostStepFunc ( cpSpace* space, void* obj, void* data ) ;
+FUNCTION: void cpSpaceAddPostStepCallback ( cpSpace* space, cpPostStepFunc func, void* obj, void* data ) ;
+CALLBACK: void cpSpacePointQueryFunc ( cpShape* shape, void* data ) ;
+FUNCTION: void cpSpacePointQuery ( cpSpace* space, cpVect point, cpLayers layers, cpGroup group, cpSpacePointQueryFunc func, void* data ) ;
+FUNCTION: cpShape* cpSpacePointQueryFirst ( cpSpace* space, cpVect point, cpLayers layers, cpGroup group ) ;
+CALLBACK: void cpSpaceSegmentQueryFunc ( cpShape* shape, cpFloat t, cpVect n, void* data ) ;
+FUNCTION: int cpSpaceSegmentQuery ( cpSpace* space, cpVect start, cpVect end, cpLayers layers, cpGroup group, cpSpaceSegmentQueryFunc func, void* data ) ;
+FUNCTION: cpShape* cpSpaceSegmentQueryFirst ( cpSpace* space, cpVect start, cpVect end, cpLayers layers, cpGroup group, cpSegmentQueryInfo* out ) ;
+CALLBACK: void cpSpaceBBQueryFunc ( cpShape* shape, void* data ) ;
+FUNCTION: void cpSpaceBBQuery ( cpSpace* space, cpBB bb, cpLayers layers, cpGroup group, cpSpaceBBQueryFunc func, void* data ) ;
+CALLBACK: void cpSpaceBodyIterator ( cpBody* body, void* data ) ;
+FUNCTION: void cpSpaceEachBody ( cpSpace* space, cpSpaceBodyIterator func, void* data ) ;
+FUNCTION: void cpSpaceResizeStaticHash ( cpSpace* space, cpFloat dim, int count ) ;
+FUNCTION: void cpSpaceResizeActiveHash ( cpSpace* space, cpFloat dim, int count ) ;
+FUNCTION: void cpSpaceRehashStatic ( cpSpace* space ) ;
+FUNCTION: void cpSpaceStep ( cpSpace* space, cpFloat dt ) ;
+
+! chipmunk.h
+FUNCTION: void cpInitChipmunk ( ) ;
+FUNCTION: cpFloat cpMomentForCircle ( cpFloat m, cpFloat r1, cpFloat r2, cpVect offset ) ;
+FUNCTION: cpFloat cpMomentForSegment ( cpFloat m, cpVect a, cpVect b ) ;
+FUNCTION: cpFloat cpMomentForPoly ( cpFloat m, int numVerts, cpVect* verts, cpVect offset ) ;
+
-FFI bindings to the Chipmunk 2D physics library.
+Chipmunk 2D physics library binding
+++ /dev/null
-USING: assocs io.pathnames fry namespaces namespaces.private kernel sequences parser hashtables ;
-IN: closures
-SYMBOL: |
-
-! Selective Binding
-: delayed-bind-with ( vars quot -- quot' ) '[ _ dup [ get ] map zip >hashtable [ _ bind ] curry ] ;
-SYNTAX: C[ | parse-until parse-quotation delayed-bind-with append! ;
-! Common ones
-SYNTAX: DIR[ parse-quotation { current-directory } swap delayed-bind-with append! ;
-
-! Namespace Binding
-: bind-to-namespace ( quot -- quot' ) '[ namespace [ _ bind ] curry ] ;
-SYNTAX: NS[ parse-quotation bind-to-namespace append! ;
2000000 sleep
] with-curses ;
-[
-] [ hello-curses ] unit-test
+curses-ok? [
+ [ ] [ hello-curses ] unit-test
+] when
combinators continuations destructors fry io.encodings.8-bit
io io.encodings.string io.encodings.utf8 kernel locals math
namespaces prettyprint sequences classes.struct
-strings threads curses.ffi ;
+strings threads curses.ffi unix.ffi ;
IN: curses
SYMBOL: curses-windows
ERROR: unnamed-window window ;
ERROR: window-not-found window ;
ERROR: curses-failed ;
+ERROR: unsupported-curses-terminal ;
: get-window ( string -- window )
dup curses-windows get at*
: curses-error ( n -- ) ERR = [ curses-failed ] when ;
+: curses-ok? ( -- ? )
+ { 0 1 2 } [ isatty 0 = not ] all? ;
+
: with-curses ( quot -- )
+ curses-ok? [ unsupported-curses-terminal ] unless
H{ } clone curses-windows [
initscr curses-error
[
{ _use_keypad bool }
{ _delay int }
- { _line char* }
+ { _line c-string }
{ _regtop NCURSES_SIZE_T }
{ _regbottom NCURSES_SIZE_T }
FUNCTION: WINDOW* initscr ( ) ;
FUNCTION: int endwin ( ) ;
FUNCTION: bool isendwin ( ) ;
-FUNCTION: SCREEN* newterm ( char* type, FILE* outfd, FILE* infd ) ;
+FUNCTION: SCREEN* newterm ( c-string type, FILE* outfd, FILE* infd ) ;
FUNCTION: SCREEN* set_term ( SCREEN* new ) ;
FUNCTION: void delscreen ( SCREEN* sp ) ;
FUNCTION: int ungetch ( int ch ) ;
FUNCTION: int has_key ( int ch ) ;
-FUNCTION: int getstr ( char* str ) ;
-FUNCTION: int getnstr ( char* str, int n ) ;
-FUNCTION: int wgetstr ( WINDOW* win, char* str ) ;
-FUNCTION: int wgetnstr ( WINDOW* win, char* str, int n ) ;
-FUNCTION: int mvgetstr ( int y, int x, char* str ) ;
-FUNCTION: int mvwgetstr ( WINDOW* win, int y, int x, char* str ) ;
-FUNCTION: int mvgetnstr ( int y, int x, char* str, int n ) ;
-FUNCTION: int mvwgetnstr ( WINDOW* win, int y, int x, char* str, int n ) ;
-
-FUNCTION: int printw ( char* fmt, int lol ) ;
-FUNCTION: int wprintw ( WINDOW* win, char* fmt, int lol ) ;
-FUNCTION: int mvprintw ( int y, int x, char* fmt, int lol ) ;
-FUNCTION: int mvwprintw ( WINDOW* win, int y, int x, char* fmt, int lol ) ;
-FUNCTION: int vwprintw ( WINDOW* win, char* fmt, va_list varglist ) ;
-FUNCTION: int vw_printw ( WINDOW* win, char* fmt, va_list varglist ) ;
+FUNCTION: int getstr ( c-string str ) ;
+FUNCTION: int getnstr ( c-string str, int n ) ;
+FUNCTION: int wgetstr ( WINDOW* win, c-string str ) ;
+FUNCTION: int wgetnstr ( WINDOW* win, c-string str, int n ) ;
+FUNCTION: int mvgetstr ( int y, int x, c-string str ) ;
+FUNCTION: int mvwgetstr ( WINDOW* win, int y, int x, c-string str ) ;
+FUNCTION: int mvgetnstr ( int y, int x, c-string str, int n ) ;
+FUNCTION: int mvwgetnstr ( WINDOW* win, int y, int x, c-string str, int n ) ;
+
+FUNCTION: int printw ( c-string fmt, int lol ) ;
+FUNCTION: int wprintw ( WINDOW* win, c-string fmt, int lol ) ;
+FUNCTION: int mvprintw ( int y, int x, c-string fmt, int lol ) ;
+FUNCTION: int mvwprintw ( WINDOW* win, int y, int x, c-string fmt, int lol ) ;
+FUNCTION: int vwprintw ( WINDOW* win, c-string fmt, va_list varglist ) ;
+FUNCTION: int vw_printw ( WINDOW* win, c-string fmt, va_list varglist ) ;
FUNCTION: int move ( int y, int x ) ;
FUNCTION: int wmove ( WINDOW* win, int y, int x ) ;
FUNCTION: int insertln ( ) ;
FUNCTION: int winsertln ( WINDOW* win ) ;
-FUNCTION: int addstr ( char* str ) ;
-FUNCTION: int addnstr ( char* str, int n ) ;
-FUNCTION: int waddstr ( WINDOW* win, char* str ) ;
-FUNCTION: int waddnstr ( WINDOW* win, char* str, int n ) ;
-FUNCTION: int mvaddstr ( int y, int x, char* str ) ;
-FUNCTION: int mvaddnstr ( int y, int x, char* str, int n ) ;
-FUNCTION: int mvwaddstr ( WINDOW* win, int y, int x, char* str ) ;
-FUNCTION: int mvwaddnstr ( WINDOW* win, int y, int x, char* str, int n ) ;
+FUNCTION: int addstr ( c-string str ) ;
+FUNCTION: int addnstr ( c-string str, int n ) ;
+FUNCTION: int waddstr ( WINDOW* win, c-string str ) ;
+FUNCTION: int waddnstr ( WINDOW* win, c-string str, int n ) ;
+FUNCTION: int mvaddstr ( int y, int x, c-string str ) ;
+FUNCTION: int mvaddnstr ( int y, int x, c-string str, int n ) ;
+FUNCTION: int mvwaddstr ( WINDOW* win, int y, int x, c-string str ) ;
+FUNCTION: int mvwaddnstr ( WINDOW* win, int y, int x, c-string str, int n ) ;
+++ /dev/null
-unportable
+++ /dev/null
-unportable
USING: words kernel sequences locals locals.parser fry
locals.definitions accessors parser namespaces continuations
summary definitions generalizations arrays prettyprint debugger io
-effects tools.annotations ;
+effects tools.annotations effects.parser ;
IN: descriptive
ERROR: descriptive-error args underlying word ;
{ n-points short }
{ points void* }
- { tags char* }
+ { tags c-string }
{ contours short* }
{ outline-flags int }
{ palette_mode char }
{ palette void* } ;
-TYPEDEF: void* FT_Face*
+C-TYPE: FT_Face
FUNCTION: FT_Error FT_New_Face ( void* library, FT_Char* font, FT_Long index, face* face ) ;
+++ /dev/null
-Sam Anklesaria
\ No newline at end of file
+++ /dev/null
-USING: arrays vectors combinators effects kernel math sequences splitting
-strings.parser parser fry sequences.extras ;
-
-! a b c glue => acb
-! c b a [ append ] dip prepend
-
-IN: fries
-: str-fry ( str on -- quot ) split
- [ unclip-last [ [ [ append ] [ prepend ] bi* ] reduce-r ] 2curry ]
- [ length 1 - 1 <effect> [ call-effect ] 2curry ] bi ;
-: gen-fry ( str on -- quot ) split
- [ unclip-last [ [ [ 1array ] [ append ] [ prepend ] tri* ] reduce-r ] 2curry ]
- [ length 1 - 1 <effect> [ call-effect ] 2curry ] bi ;
-
-SYNTAX: i" parse-string rest "_" str-fry append! ;
-SYNTAX: i{ \ } parse-until >array { _ } gen-fry append! ;
-SYNTAX: iV{ \ } parse-until >vector V{ _ } gen-fry append! ;
+++ /dev/null
-Generalized Frying
\ No newline at end of file
USING: accessors assocs compiler.units continuations fuel.eval fuel.help
fuel.remote fuel.xref help.topics io.pathnames kernel namespaces parser
-sequences tools.scaffold vocabs.loader vocabs.parser words ;
+sequences tools.scaffold vocabs.loader vocabs.parser words vocabs.files
+vocabs.metadata ;
IN: fuel
[ fuel-scaffold-name dup require dup scaffold-help ] with-scope
vocab-docs-path absolute-path fuel-eval-set-result ;
+: fuel-scaffold-tests ( name devname -- )
+ [ fuel-scaffold-name dup require dup scaffold-tests ] with-scope
+ vocab-tests-file absolute-path fuel-eval-set-result ;
+
+: fuel-scaffold-authors ( name devname -- )
+ [ fuel-scaffold-name dup require dup scaffold-authors ] with-scope
+ [ vocab-authors-path ] keep swap vocab-append-path absolute-path fuel-eval-set-result ;
+
+: fuel-scaffold-tags ( name tags -- )
+ [ scaffold-tags ]
+ [ drop [ vocab-tags-path ] keep swap vocab-append-path absolute-path fuel-eval-set-result ] 2bi ;
+
+: fuel-scaffold-summary ( name summary -- )
+ [ scaffold-summary ]
+ [ drop [ vocab-summary-path ] keep swap vocab-append-path absolute-path fuel-eval-set-result ] 2bi ;
+
+: fuel-scaffold-platforms ( name platforms -- )
+ [ scaffold-platforms ]
+ [ drop [ vocab-platforms-path ] keep swap vocab-append-path absolute-path fuel-eval-set-result ] 2bi ;
+
: fuel-scaffold-get-root ( name -- ) find-vocab-root fuel-eval-set-result ;
! Remote connection
{ "tick-interval-micros" integer } { "delegate" "a " { $link "game.loop-delegates" } }
{ "loop" game-loop }
}
-{ $description "Constructs a new stopped " { $link game-loop } " object. When started, the game loop will call the " { $link tick* } " method on the " { $snippet "delegate" } " every " { $snippet "tick-interval-micros" } " microseconds, and " { $link draw* } " on the delegate as frequently as possible. The " { $link start-loop } " and " { $link stop-loop } " words start and stop the game loop." } ;
+{ $description "Constructs a new stopped " { $link game-loop } " object. When started, the game loop will call the " { $link tick* } " method on the " { $snippet "delegate" } " every " { $snippet "tick-interval-micros" } " microseconds, and " { $link draw* } " on the same delegate object as frequently as possible. The " { $link start-loop } " and " { $link stop-loop } " words start and stop the game loop."
+$nl
+"To initialize the game loop with separate tick and draw delegates, use " { $link <game-loop*> } "." } ;
+
+HELP: <game-loop*>
+{ $values
+ { "tick-interval-micros" integer } { "tick-delegate" "a " { $link "game.loop-delegates" } } { "draw-delegate" "a " { $link "game.loop-delegates" } }
+ { "loop" game-loop }
+}
+{ $description "Constructs a new stopped " { $link game-loop } " object. When started, the game loop will call the " { $link tick* } " method on the " { $snippet "tick-delegate" } " every " { $snippet "tick-interval-micros" } " microseconds, and " { $link draw* } " on the " { $snippet "draw-delegate" } " as frequently as possible. The " { $link start-loop } " and " { $link stop-loop } " words start and stop the game loop."
+$nl
+"The " { $link <game-loop> } " word provides a shorthand for initializing a game loop that uses the same object for the " { $snippet "tick-delegate" } " and " { $snippet "draw-delegate" } "." } ;
+
+{ <game-loop> <game-loop*> } related-words
HELP: benchmark-frames-per-second
{ $values
{ "loop" game-loop }
{ "n" float }
}
-{ $description "Returns the average number of times per second the game loop has called " { $link tick* } " on its delegate since the game loop was started with " { $link start-loop } " or since the benchmark counters have been reset with " { $link reset-loop-benchmark } "." } ;
+{ $description "Returns the average number of times per second the game loop has called " { $link tick* } " on its tick delegate since the game loop was started with " { $link start-loop } " or since the benchmark counters have been reset with " { $link reset-loop-benchmark } "." } ;
{ reset-loop-benchmark benchmark-frames-per-second benchmark-ticks-per-second } related-words
{ $values
{ "tick-slice" float } { "delegate" "a " { $link "game.loop-delegates" } }
}
-{ $description "This generic word is called by a " { $link game-loop } " on its " { $snippet "delegate" } " object in a tight loop while the game loop is running. The " { $snippet "tick-slice" } " value represents what fraction of the game loop's " { $snippet "tick-interval-micros" } " time period has passed since " { $link tick* } " was most recently called on the delegate." } ;
+{ $description "This generic word is called by a " { $link game-loop } " on its " { $snippet "draw-delegate" } " object in a tight loop while the game loop is running. The " { $snippet "tick-slice" } " value represents what fraction of the game loop's " { $snippet "tick-interval-micros" } " time period has passed since " { $link tick* } " was most recently called on the " { $snippet "tick-delegate" } "." } ;
HELP: game-loop
-{ $class-description "Objects of the " { $snippet "game-loop" } " class manage game loops. See " { $link "game.loop" } " for an overview of the game loop library. To construct a game loop, use " { $link <game-loop> } ". To start and stop a game loop, use the " { $link start-loop } " and " { $link stop-loop } " words." } ;
+{ $class-description "Objects of the " { $snippet "game-loop" } " class manage game loops. See " { $link "game.loop" } " for an overview of the game loop library. To construct a game loop, use " { $link <game-loop> } ". To start and stop a game loop, use the " { $link start-loop } " and " { $link stop-loop } " words."
+$nl
+"The " { $snippet "tick-delegate" } " and " { $snippet "draw-delegate" } " slots of a game loop object determine where the loop sends its " { $link tick* } " and " { $link draw* } " events. These slots can be changed while the game loop is running." } ;
HELP: game-loop-error
{ $values
{ $values
{ "delegate" "a " { $link "game.loop-delegates" } }
}
-{ $description "This generic word is called by a " { $link game-loop } " on its " { $snippet "delegate" } " object at regular intervals while the game loop is running. The game loop's " { $snippet "tick-interval-micros" } " attribute determines the number of microseconds between invocations of " { $snippet "tick*" } "." } ;
+{ $description "This generic word is called by a " { $link game-loop } " on its " { $snippet "tick-delegate" } " object at regular intervals while the game loop is running. The game loop's " { $snippet "tick-interval-micros" } " attribute determines the number of microseconds between invocations of " { $snippet "tick*" } "." } ;
{ draw* tick* } related-words
ARTICLE: "game.loop-delegates" "Game loop delegate"
-"A " { $link game-loop } " object requires a " { $snippet "delegate" } " that implements the logic that controls the game. A game loop delegate can be any object that provides two methods for the following generic words:"
+"A " { $link game-loop } " object requires a " { $snippet "tick-delegate" } " and " { $snippet "draw-delegate" } " that together implement the logic that controls the game. Both delegates can also be the same object. A game loop delegate can be any object that provides two methods for the following generic words:"
{ $subsections
tick*
draw*
}
-{ $snippet "tick*" } " will be called at a regular interval determined by the game loop's " { $snippet "tick-interval-micros" } " attribute. " { $snippet "draw*" } " will be invoked in a tight loop, updating as frequently as possible." ;
+{ $snippet "tick*" } " will be called at a regular interval determined by the game loop's " { $snippet "tick-interval-micros" } " attribute on the tick delegate. " { $snippet "draw*" } " will be invoked on the draw delegate in a tight loop, updating as frequently as possible."
+$nl
+"It is possible to change the " { $snippet "tick-delegate" } " and " { $snippet "draw-delegate" } " slots of a game loop while it is running, for example, to use different delegates to control a game while it's in the menu, paused, or running the main game." ;
ARTICLE: "game.loop" "Game loops"
-"The " { $vocab-link "game.loop" } " vocabulary contains the implementation of a game loop. The game loop supports decoupled rendering and game logic timers; given a delegate object with methods on the " { $link tick* } " and " { $link draw* } " methods, the game loop will invoke the " { $snippet "tick*" } " method at regular intervals while invoking the " { $snippet "draw*" } " method as frequently as possible. Game loop objects must first be constructed:"
+"The " { $vocab-link "game.loop" } " vocabulary contains the implementation of a game loop. The game loop supports decoupled rendering and game logic timers; given a \"tick delegate\" object with a method on the " { $link tick* } " generic and a \"draw delegate\" with a " { $link draw* } " method, the game loop will invoke the " { $snippet "tick*" } " method on the former at regular intervals while invoking the " { $snippet "draw*" } " method on the latter as frequently as possible. Game loop objects must first be constructed:"
{ $subsections
"game.loop-delegates"
<game-loop>
+ <game-loop*>
}
"Once constructed, the game loop can be started and stopped:"
{ $subsections
start-loop
stop-loop
}
-"The game loop maintains performance counters for measuring drawing frames and ticks per second:"
+"The game loop maintains performance counters:"
{ $subsections
reset-loop-benchmark
benchmark-frames-per-second
benchmark-ticks-per-second
}
-"The game loop manages errors that occur in the delegate's methods during the course of the game loop:"
+"The game loop catches errors that occur in the delegate's methods during the course of the game loop:"
{ $subsections
game-loop-error
}
TUPLE: game-loop
{ tick-interval-micros integer read-only }
- delegate
+ tick-delegate
+ draw-delegate
{ last-tick integer }
thread
{ running? boolean }
: redraw ( loop -- )
[ 1 + ] change-frame-number
- [ tick-slice ] [ delegate>> ] bi draw* ;
+ [ tick-slice ] [ draw-delegate>> ] bi draw* ;
: tick ( loop -- )
- delegate>> tick* ;
+ tick-delegate>> tick* ;
: increment-tick ( loop -- )
[ 1 + ] change-tick-number
f >>thread
drop ;
-: <game-loop> ( tick-interval-micros delegate -- loop )
+: <game-loop*> ( tick-interval-micros tick-delegate draw-delegate -- loop )
system-micros f f 0 0 system-micros 0 0
game-loop boa ;
+: <game-loop> ( tick-interval-micros delegate -- loop )
+ dup <game-loop*> ; inline
+
M: game-loop dispose
stop-loop ;
HELP: z-up { $class-description "Right-handed 3D coordinate system where Z is up." } ;
HELP: >y-up-axis!
-{ $values { "seq" sequence } { "from-axis" rh-up } { "seq" sequence } }
+{ $values { "seq" sequence } { "from-axis" rh-up } }
{ $description "Destructively swizzles the first three elements of the input sequence to a right-handed 3D coordinate system where Y is up and returns the modified sequence." } ;
HELP: source>seq
{ $description "Convert the mesh tag's vertices element to a pair for further lookup in " { $link collect-sources } ". " } ;
HELP: collect-sources
-{ $values { "sources" hashtable } { "vertices" pair } { "inputs" tag sequence } { "sources" sequence } }
+{ $values { "sources" hashtable } { "vertices" pair } { "inputs" tag sequence } { "seq" sequence } }
{ $description "Look up the sources for these " { $emphasis "input" } " elements and return a sequence of " { $link source } " tuples." } ;
HELP: group-indices
] x*
] bi 2array ;
-:: collect-sources ( sources vertices inputs -- sources )
+:: collect-sources ( sources vertices inputs -- seq )
inputs
[| input |
input "source" x@ rest vertices first =
{ $description "Convert a face line to a sequence of vertex attributes." } ;
HELP: push*
-{ $values { "elt" "an object" } { "seq" sequence } { "seq" sequence } }
+{ $values { "elt" "an object" } { "seq" sequence } }
{ $description "Push the value onto the sequence, keeping the sequence on the stack." } ;
HELP: push-current-model
M: game-world begin-world
dup use-game-input?>> [ open-game-input ] when
dup use-audio-engine?>> [ dup open-game-audio-engine >>audio-engine ] when
- dup begin-game-world
- dup [ tick-interval-micros>> ] [ ] bi <game-loop> [ >>game-loop ] keep start-loop
- drop ;
+ dup [ tick-interval-micros>> ] [ ] bi <game-loop>
+ [ >>game-loop begin-game-world ] keep start-loop ;
M: game-world end-world
[ [ stop-loop ] when* f ] change-game-loop
combinators.short-circuit game.loop game.worlds gpu gpu.buffers
gpu.util.wasd gpu.framebuffers gpu.render gpu.shaders gpu.state
gpu.textures gpu.util grouping http.client images images.loader
-io io.encodings.ascii io.files io.files.temp kernel locals math
-math.matrices math.vectors.simd math.parser math.vectors
+images.tiff io io.encodings.ascii io.files io.files.temp kernel
+locals math math.matrices math.vectors.simd math.parser math.vectors
method-chains namespaces sequences splitting threads ui ui.gadgets
ui.gadgets.worlds ui.pixel-formats specialized-arrays
specialized-vectors literals ;
USING: tools.deploy.config ;
H{
- { deploy-name "gpu.demos.bunny" }
- { deploy-word-defs? f }
- { deploy-io 3 }
+ { deploy-name "Bunny" }
+ { deploy-ui? t }
+ { deploy-c-types? f }
+ { deploy-unicode? f }
{ "stop-after-last-window?" t }
- { deploy-math? t }
+ { deploy-io 3 }
+ { deploy-reflection 1 }
{ deploy-word-props? f }
+ { deploy-math? t }
{ deploy-threads? t }
- { deploy-c-types? f }
- { deploy-reflection 2 }
- { deploy-unicode? f }
- { deploy-ui? t }
+ { deploy-word-defs? f }
}
--- /dev/null
+loading.tiff
--- /dev/null
+USING: tools.deploy.config ;
+H{
+ { deploy-name "Raytrace" }
+ { deploy-ui? t }
+ { deploy-c-types? f }
+ { deploy-unicode? f }
+ { "stop-after-last-window?" t }
+ { deploy-io 2 }
+ { deploy-reflection 2 }
+ { deploy-word-props? f }
+ { deploy-math? t }
+ { deploy-threads? t }
+ { deploy-word-defs? f }
+}
--- /dev/null
+green-ball.aiff
+mirror-ball.aiff
+red-ball.aiff
+yellow-ball.aiff
"gpu.shaders"
"gpu.render"
}
-"The library is built on top of the OpenGL API, but it aims to be complete enough that raw OpenGL calls are never needed. OpenGL 2.0 with the vertex array object extension (" { $snippet "GL_APPLE_vertex_array_object" } " or " { $snippet "GL_ARB_vertex_array_object" } ") is required. Some features require later OpenGL versions or additional extensions; these requirements are documented alongside individual words. To make full use of the library, an OpenGL 3.1 or later implementation is recommended." ;
+"The library is built on top of the OpenGL API, but it aims to be complete enough that raw OpenGL calls are never needed. OpenGL 2.0 is required. Some features require later OpenGL versions or additional extensions; these requirements are documented alongside individual words. To make full use of the library, an OpenGL 3.1 or later implementation is recommended." ;
ABOUT: "gpu-summary"
VARIANT: gpu-api
opengl-2 opengl-3 ;
+SYMBOL: has-vertex-array-objects?
+
: set-gpu-api ( -- )
"2.0" require-gl-version
"3.0" { { "GL_ARB_vertex_array_object" "GL_APPLE_vertex_array_object" } }
- require-gl-version-or-extensions
+ has-gl-version-or-extensions? has-vertex-array-objects? set-global
"3.0" has-gl-version? opengl-3 opengl-2 ? gpu-api set-global ;
HOOK: init-gpu-api gpu-api ( -- )
<PRIVATE
-: bind-vertex-array ( vertex-array -- )
- handle>> glBindVertexArray ;
-
: bind-unnamed-output-attachments ( framebuffer attachments -- )
[ gl-attachment ] with map
dup length 1 =
TUPLE: render-set
{ primitive-mode primitive-mode read-only }
- { vertex-array vertex-array read-only }
+ { vertex-array vertex-array initial: T{ vertex-array-collection } read-only }
{ uniforms uniform-tuple read-only }
{ indexes vertex-indexes initial: T{ index-range } read-only }
{ instances ?integer initial: f read-only }
{ $class-description "This " { $link shader-kind } " indicates that a " { $link shader } " is a vertex shader." } ;
HELP: vertex-array
-{ $class-description "A " { $snippet "vertex-array" } " object associates a shader " { $link program-instance } " with vertex attribute data from one or more " { $link buffer } "s. The format of the binary data inside these buffers is described using " { $link vertex-format } "s. " { $snippet "vertex-array" } "s are constructed using the " { $link <multi-vertex-array> } " or " { $link <vertex-array*> } " words." } ;
+{ $class-description "A " { $snippet "vertex-array" } " object associates a shader " { $link program-instance } " with vertex attribute data from one or more " { $link buffer } "s. The format of the binary data inside these buffers is described using " { $link vertex-format } "s. " { $snippet "vertex-array" } "s are constructed using the " { $link <multi-vertex-array> } " or " { $link <vertex-array*> } " words. The actual type of a vertex-array object is opaque, but the " { $link vertex-array-buffers } " word can be used to query a vertex array object for its component buffers." } ;
+
+HELP: vertex-array-buffers
+{ $values
+ { "vertex-array" vertex-array }
+ { "buffers" sequence }
+}
+{ $description "Returns a sequence containing all of the " { $link buffer } " objects that make up " { $snippet "vertex-array" } "." } ;
HELP: vertex-array-buffer
{ $values
{ "vertex-array" vertex-array }
{ "vertex-buffer" buffer }
}
-{ $description "Returns the first " { $link buffer } " object comprised in " { $snippet "vertex-array" } "." } ;
+{ $description "Returns the first " { $link buffer } " object that makes up " { $snippet "vertex-array" } "." } ;
+
+{ vertex-array-buffer vertex-array-buffers } related-words
HELP: vertex-attribute
{ $class-description "This tuple type is passed to " { $link define-vertex-format } " to define a new " { $link vertex-format } " type." } ;
{ $subsections
vertex-array
<multi-vertex-array>
- vertex-array
+ <vertex-array*>
+ <vertex-array>
POSTPONE: VERTEX-FORMAT:
} ;
USING: accessors alien alien.c-types alien.data alien.strings
arrays assocs byte-arrays classes.mixin classes.parser
classes.singleton classes.struct combinators combinators.short-circuit
-definitions destructors fry generic.parser gpu gpu.buffers hashtables
-images io.encodings.ascii io.files io.pathnames kernel lexer
-literals locals math math.parser memoize multiline namespaces
+definitions destructors fry generic.parser gpu gpu.buffers gpu.private
+gpu.state hashtables images io.encodings.ascii io.files io.pathnames
+kernel lexer literals locals math math.parser memoize multiline namespaces
opengl opengl.gl opengl.shaders parser quotations sequences
specialized-arrays splitting strings tr ui.gadgets.worlds
variants vectors vocabs vocabs.loader vocabs.parser words
SYNTAX: VERTEX-STRUCT:
CREATE-CLASS scan-word define-vertex-struct ;
-TUPLE: vertex-array < gpu-object
+TUPLE: vertex-array-object < gpu-object
{ program-instance program-instance read-only }
{ vertex-buffers sequence read-only } ;
-M: vertex-array dispose
+TUPLE: vertex-array-collection
+ { vertex-formats sequence read-only }
+ { program-instance program-instance read-only } ;
+
+UNION: vertex-array
+ vertex-array-object vertex-array-collection ;
+
+M: vertex-array-object dispose
[ [ delete-vertex-array ] when* f ] change-handle drop ;
: ?>buffer-ptr ( buffer/ptr -- buffer-ptr )
: ?>buffer ( buffer/ptr -- buffer )
dup buffer? [ buffer>> ] unless ; inline
-:: <multi-vertex-array> ( vertex-formats program-instance -- vertex-array )
+<PRIVATE
+
+: normalize-vertex-formats ( vertex-formats -- vertex-formats' )
+ [ first2 [ ?>buffer-ptr ] dip 2array ] map ; inline
+
+: (bind-vertex-array) ( vertex-formats program-instance -- )
+ '[ _ swap first2 bind-vertex-format ] each ; inline
+
+: (reset-vertex-array) ( -- )
+ GL_MAX_VERTEX_ATTRIBS get-gl-int iota [ glDisableVertexAttribArray ] each ; inline
+
+:: <multi-vertex-array-object> ( vertex-formats program-instance -- vertex-array )
gen-vertex-array :> handle
handle glBindVertexArray
- vertex-formats [ program-instance swap first2 [ ?>buffer-ptr ] dip bind-vertex-format ] each
+ vertex-formats normalize-vertex-formats program-instance (bind-vertex-array)
+
handle program-instance vertex-formats [ first ?>buffer ] map
- vertex-array boa window-resource ; inline
+ vertex-array-object boa window-resource ; inline
-:: <vertex-array*> ( vertex-buffer program-instance format -- vertex-array )
+: <multi-vertex-array-collection> ( vertex-formats program-instance -- vertex-array )
+ [ normalize-vertex-formats ] dip vertex-array-collection boa ; inline
+
+:: <vertex-array-object> ( vertex-buffer program-instance format -- vertex-array )
gen-vertex-array :> handle
handle glBindVertexArray
program-instance vertex-buffer ?>buffer-ptr format bind-vertex-format
handle program-instance vertex-buffer ?>buffer 1array
- vertex-array boa window-resource ; inline
+ vertex-array-object boa window-resource ; inline
+
+: <vertex-array-collection> ( vertex-buffer program-instance format -- vertex-array )
+ swap [ [ ?>buffer-ptr ] dip 2array 1array ] dip <multi-vertex-array-collection> ; inline
+
+PRIVATE>
+
+GENERIC: bind-vertex-array ( vertex-array -- )
+
+M: vertex-array-object bind-vertex-array
+ handle>> glBindVertexArray ; inline
+
+M: vertex-array-collection bind-vertex-array
+ (reset-vertex-array)
+ [ vertex-formats>> ] [ program-instance>> ] bi (bind-vertex-array) ; inline
+
+: <multi-vertex-array> ( vertex-formats program-instance -- vertex-array )
+ has-vertex-array-objects? get
+ [ <multi-vertex-array-object> ]
+ [ <multi-vertex-array-collection> ] if ; inline
+
+: <vertex-array*> ( vertex-buffer program-instance format -- vertex-array )
+ has-vertex-array-objects? get
+ [ <vertex-array-object> ]
+ [ <vertex-array-collection> ] if ; inline
: <vertex-array> ( vertex-buffer program-instance -- vertex-array )
dup program>> vertex-formats>> first <vertex-array*> ; inline
-TYPED: vertex-array-buffer ( vertex-array: vertex-array -- vertex-buffer: buffer )
- vertex-buffers>> first ;
+GENERIC: vertex-array-buffers ( vertex-array -- buffers )
+
+M: vertex-array-object vertex-array-buffers
+ vertex-buffers>> ; inline
+
+M: vertex-array-collection vertex-array-buffers
+ vertex-formats>> [ first buffer>> ] map ; inline
+
+: vertex-array-buffer ( vertex-array: vertex-array -- vertex-buffer: buffer )
+ vertex-array-buffers first ; inline
TUPLE: compile-shader-error shader log ;
TUPLE: link-program-error program log ;
[ [ set-gpu-state* ] each ]
[ set-gpu-state* ] if ; inline
-<PRIVATE
-
: get-gl-bool ( enum -- value )
0 <uchar> [ glGetBooleanv ] keep *uchar c-bool> ;
: get-gl-int ( enum -- value )
: gl-enabled? ( enum -- ? )
glIsEnabled c-bool> ;
-PRIVATE>
-
TYPED: get-viewport-state ( -- viewport-state: viewport-state )
GL_VIEWPORT get-gl-rect <viewport-state> ;
{ { $link DXT1-RGBA } }
{ { $link DXT3 } }
{ { $link DXT5 } }
+{ { $link LATC1 } }
+{ { $link LATC1-SIGNED } }
+{ { $link LATC2 } }
+{ { $link LATC2-SIGNED } }
{ { $link RGTC1 } }
{ { $link RGTC1-SIGNED } }
{ { $link RGTC2 } }
{ { $link RGTC2-SIGNED } }
} }
-{ $notes "The " { $snippet "DXT1" } " formats require either the " { $snippet "GL_EXT_texture_compression_s3tc" } " or " { $snippet "GL_EXT_texture_compression_dxt1" } " extension. The other " { $snippet "DXT" } " formats require the " { $snippet "GL_EXT_texture_compression_s3tc" } " extension. The " { $snippet "RGTC" } " formats require OpenGL 3.0 or later or the " { $snippet "GL_EXT_texture_compression_rgtc" } " extension." } ;
+{ $notes "The " { $snippet "DXT1" } " formats require either the " { $snippet "GL_EXT_texture_compression_s3tc" } " or " { $snippet "GL_EXT_texture_compression_dxt1" } " extension. The other " { $snippet "DXT" } " formats require the " { $snippet "GL_EXT_texture_compression_s3tc" } " extension. The " { $snippet "LATC" } " formats require the " { $snippet "GL_EXT_texture_compression_latc" } " extension. The " { $snippet "RGTC" } " formats require OpenGL 3.0 or later or the " { $snippet "GL_EXT_texture_compression_rgtc" } " extension." } ;
HELP: compressed-texture-data
{ $class-description { $snippet "compressed-texture-data" } " tuples are used to feed compressed texture data to " { $link allocate-compressed-texture } " and " { $link update-compressed-texture } "."
VARIANT: compressed-texture-format
DXT1-RGB DXT1-RGBA DXT3 DXT5
+ LATC1 LATC1-SIGNED LATC2 LATC2-SIGNED
RGTC1 RGTC1-SIGNED RGTC2 RGTC2-SIGNED ;
TUPLE: compressed-texture-data
"[let { 1 2 3 4 } :> myarr [infix myarr[4/2]*3 infix] ] ."
"9"
}
-"Please note: in Factor " { $emphasis "fixnums are sequences too." } " If you are not careful with sequence accesses you may introduce subtle bugs:"
-{ $example
- "USING: arrays infix locals ;"
- ":: add-2nd-elements ( x y -- res )"
- " [infix x[1] + y[1] infix] ;"
- "{ 1 2 3 } { 0 1 2 3 } add-2nd-elements ."
- "3"
-}
;
ABOUT: "infix"
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-unportable
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.syntax alien.data
classes.struct combinators io.ports io.streams.duplex
-system kernel math math.bitwise vocabs.loader unix io.serial
-io.serial.unix.termios io.backend.unix ;
+system kernel math math.bitwise vocabs.loader io.serial
+io.serial.unix.termios io.backend.unix unix unix.ffi ;
IN: io.serial.unix
<< {
+++ /dev/null
-unportable
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: io.files.windows io.streams.duplex kernel math
-math.bitwise windows.kernel32 accessors alien.c-types
-windows io.files.windows fry locals continuations
-classes.struct ;
+math.bitwise windows windows.kernel32 windows.errors accessors
+alien.c-types fry locals continuations classes.struct ;
IN: io.serial.windows
: <serial-stream> ( path encoding -- duplex )
--- /dev/null
+Erik Charlebois
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien alien.c-types alien.libraries
+alien.syntax classes.struct combinators endian io.binary
+kernel locals math sequences specialized-arrays
+system unix.time unix.types ;
+FROM: alien.c-types => short ;
+IN: libusb
+
+<< "libusb" {
+ { [ os windows? ] [ "libusb-1.0.dll" ] }
+ { [ os macosx? ] [ "libusb-1.0.dylib" ] }
+ { [ os unix? ] [ "libusb-1.0.so" ] }
+ } cond "cdecl" add-library >>
+LIBRARY: libusb
+
+: libusb_cpu_to_le16 ( x -- y )
+ 2 >native-endian le> ; inline
+
+ALIAS: libusb_le16_to_cpu libusb_cpu_to_le16
+
+CONSTANT: LIBUSB_CLASS_PER_INTERFACE 0
+CONSTANT: LIBUSB_CLASS_AUDIO 1
+CONSTANT: LIBUSB_CLASS_COMM 2
+CONSTANT: LIBUSB_CLASS_HID 3
+CONSTANT: LIBUSB_CLASS_PRINTER 7
+CONSTANT: LIBUSB_CLASS_PTP 6
+CONSTANT: LIBUSB_CLASS_MASS_STORAGE 8
+CONSTANT: LIBUSB_CLASS_HUB 9
+CONSTANT: LIBUSB_CLASS_DATA 10
+CONSTANT: LIBUSB_CLASS_VENDOR_SPEC HEX: ff
+TYPEDEF: int libusb_class_code
+
+CONSTANT: LIBUSB_DT_DEVICE HEX: 01
+CONSTANT: LIBUSB_DT_CONFIG HEX: 02
+CONSTANT: LIBUSB_DT_STRING HEX: 03
+CONSTANT: LIBUSB_DT_INTERFACE HEX: 04
+CONSTANT: LIBUSB_DT_ENDPOINT HEX: 05
+CONSTANT: LIBUSB_DT_HID HEX: 21
+CONSTANT: LIBUSB_DT_REPORT HEX: 22
+CONSTANT: LIBUSB_DT_PHYSICAL HEX: 23
+CONSTANT: LIBUSB_DT_HUB HEX: 29
+TYPEDEF: int libusb_descriptor_type
+
+CONSTANT: LIBUSB_DT_DEVICE_SIZE 18
+CONSTANT: LIBUSB_DT_CONFIG_SIZE 9
+CONSTANT: LIBUSB_DT_INTERFACE_SIZE 9
+CONSTANT: LIBUSB_DT_ENDPOINT_SIZE 7
+CONSTANT: LIBUSB_DT_ENDPOINT_AUDIO_SIZE 9
+CONSTANT: LIBUSB_DT_HUB_NONVAR_SIZE 7
+
+CONSTANT: LIBUSB_ENDPOINT_ADDRESS_MASK HEX: 0f
+CONSTANT: LIBUSB_ENDPOINT_DIR_MASK HEX: 80
+
+CONSTANT: LIBUSB_ENDPOINT_IN HEX: 80
+CONSTANT: LIBUSB_ENDPOINT_OUT HEX: 00
+TYPEDEF: int libusb_endpoint_direction
+
+CONSTANT: LIBUSB_TRANSFER_TYPE_MASK HEX: 03
+
+CONSTANT: LIBUSB_TRANSFER_TYPE_CONTROL 0
+CONSTANT: LIBUSB_TRANSFER_TYPE_ISOCHRONOUS 1
+CONSTANT: LIBUSB_TRANSFER_TYPE_BULK 2
+CONSTANT: LIBUSB_TRANSFER_TYPE_INTERRUPT 3
+TYPEDEF: int libusb_transfer_type
+
+CONSTANT: LIBUSB_REQUEST_GET_STATUS HEX: 00
+CONSTANT: LIBUSB_REQUEST_CLEAR_FEATURE HEX: 01
+CONSTANT: LIBUSB_REQUEST_SET_FEATURE HEX: 03
+CONSTANT: LIBUSB_REQUEST_SET_ADDRESS HEX: 05
+CONSTANT: LIBUSB_REQUEST_GET_DESCRIPTOR HEX: 06
+CONSTANT: LIBUSB_REQUEST_SET_DESCRIPTOR HEX: 07
+CONSTANT: LIBUSB_REQUEST_GET_CONFIGURATION HEX: 08
+CONSTANT: LIBUSB_REQUEST_SET_CONFIGURATION HEX: 09
+CONSTANT: LIBUSB_REQUEST_GET_INTERFACE HEX: 0A
+CONSTANT: LIBUSB_REQUEST_SET_INTERFACE HEX: 0B
+CONSTANT: LIBUSB_REQUEST_SYNCH_FRAME HEX: 0C
+TYPEDEF: int libusb_standard_request
+
+CONSTANT: LIBUSB_REQUEST_TYPE_STANDARD HEX: 00
+CONSTANT: LIBUSB_REQUEST_TYPE_CLASS HEX: 20
+CONSTANT: LIBUSB_REQUEST_TYPE_VENDOR HEX: 40
+CONSTANT: LIBUSB_REQUEST_TYPE_RESERVED HEX: 60
+
+CONSTANT: LIBUSB_RECIPIENT_DEVICE HEX: 00
+CONSTANT: LIBUSB_RECIPIENT_INTERFACE HEX: 01
+CONSTANT: LIBUSB_RECIPIENT_ENDPOINT HEX: 02
+CONSTANT: LIBUSB_RECIPIENT_OTHER HEX: 03
+TYPEDEF: int libusb_request_recipient
+
+CONSTANT: LIBUSB_ISO_SYNC_TYPE_MASK HEX: 0C
+
+CONSTANT: LIBUSB_ISO_SYNC_TYPE_NONE 0
+CONSTANT: LIBUSB_ISO_SYNC_TYPE_ASYNC 1
+CONSTANT: LIBUSB_ISO_SYNC_TYPE_ADAPTIVE 2
+CONSTANT: LIBUSB_ISO_SYNC_TYPE_SYNC 3
+TYPEDEF: int libusb_iso_sync_type
+
+CONSTANT: LIBUSB_ISO_USAGE_TYPE_MASK HEX: 30
+
+CONSTANT: LIBUSB_ISO_USAGE_TYPE_DATA 0
+CONSTANT: LIBUSB_ISO_USAGE_TYPE_FEEDBACK 1
+CONSTANT: LIBUSB_ISO_USAGE_TYPE_IMPLICIT 2
+TYPEDEF: int libusb_iso_usage_type
+
+STRUCT: libusb_device_descriptor
+ { bLength uint8_t }
+ { bDescriptorType uint8_t }
+ { bcdUSB uint16_t }
+ { bDeviceClass uint8_t }
+ { bDeviceSubClass uint8_t }
+ { bDeviceProtocol uint8_t }
+ { bMaxPacketSize0 uint8_t }
+ { idVendor uint16_t }
+ { idProduct uint16_t }
+ { bcdDevice uint16_t }
+ { iManufacturer uint8_t }
+ { iProduct uint8_t }
+ { iSerialNumber uint8_t }
+ { bNumConfigurations uint8_t } ;
+
+STRUCT: libusb_endpoint_descriptor
+ { bLength uint8_t }
+ { bDescriptorType uint8_t }
+ { bEndpointAddress uint8_t }
+ { bmAttributes uint8_t }
+ { wMaxPacketSize uint16_t }
+ { bInterval uint8_t }
+ { bRefresh uint8_t }
+ { bSynchAddress uint8_t }
+ { extra uchar* }
+ { extra_length int } ;
+
+STRUCT: libusb_interface_descriptor
+ { bLength uint8_t }
+ { bDescriptorType uint8_t }
+ { bInterfaceNumber uint8_t }
+ { bAlternateSetting uint8_t }
+ { bNumEndpoints uint8_t }
+ { bInterfaceClass uint8_t }
+ { bInterfaceSubClass uint8_t }
+ { bInterfaceProtocol uint8_t }
+ { iInterface uint8_t }
+ { endpoint libusb_endpoint_descriptor* }
+ { extra uchar* }
+ { extra_length int } ;
+
+STRUCT: libusb_interface
+ { altsetting libusb_interface_descriptor* }
+ { num_altsetting int } ;
+
+STRUCT: libusb_config_descriptor
+ { bLength uint8_t }
+ { bDescriptorType uint8_t }
+ { wTotalLength uint16_t }
+ { bNumInterfaces uint8_t }
+ { bConfigurationValue uint8_t }
+ { iConfiguration uint8_t }
+ { bmAttributes uint8_t }
+ { MaxPower uint8_t }
+ { interface libusb_interface* }
+ { extra uchar* }
+ { extra_length int } ;
+
+STRUCT: libusb_control_setup
+ { bmRequestType uint8_t }
+ { bRequest uint8_t }
+ { wValue uint16_t }
+ { wIndex uint16_t }
+ { wLength uint16_t } ;
+
+: LIBUSB_CONTROL_SETUP_SIZE ( -- x ) libusb_control_setup heap-size ; inline
+
+C-TYPE: libusb_context
+C-TYPE: libusb_device
+C-TYPE: libusb_device_handle
+
+CONSTANT: LIBUSB_SUCCESS 0
+CONSTANT: LIBUSB_ERROR_IO -1
+CONSTANT: LIBUSB_ERROR_INVALID_PARAM -2
+CONSTANT: LIBUSB_ERROR_ACCESS -3
+CONSTANT: LIBUSB_ERROR_NO_DEVICE -4
+CONSTANT: LIBUSB_ERROR_NOT_FOUND -5
+CONSTANT: LIBUSB_ERROR_BUSY -6
+CONSTANT: LIBUSB_ERROR_TIMEOUT -7
+CONSTANT: LIBUSB_ERROR_OVERFLOW -8
+CONSTANT: LIBUSB_ERROR_PIPE -9
+CONSTANT: LIBUSB_ERROR_INTERRUPTED -10
+CONSTANT: LIBUSB_ERROR_NO_MEM -11
+CONSTANT: LIBUSB_ERROR_NOT_SUPPORTED -12
+CONSTANT: LIBUSB_ERROR_OTHER -99
+TYPEDEF: int libusb_error
+
+C-ENUM:
+ LIBUSB_TRANSFER_COMPLETED
+ LIBUSB_TRANSFER_ERROR
+ LIBUSB_TRANSFER_TIMED_OUT
+ LIBUSB_TRANSFER_CANCELLED
+ LIBUSB_TRANSFER_STALL
+ LIBUSB_TRANSFER_NO_DEVICE
+ LIBUSB_TRANSFER_OVERFLOW ;
+TYPEDEF: int libusb_transfer_status
+
+CONSTANT: LIBUSB_TRANSFER_SHORT_NOT_OK 1
+CONSTANT: LIBUSB_TRANSFER_FREE_BUFFER 2
+CONSTANT: LIBUSB_TRANSFER_FREE_TRANSFER 4
+TYPEDEF: int libusb_transfer_flags
+
+STRUCT: libusb_iso_packet_descriptor
+ { length uint }
+ { actual_length uint }
+ { status libusb_transfer_status } ;
+SPECIALIZED-ARRAY: libusb_iso_packet_descriptor
+
+C-TYPE: libusb_transfer
+
+CALLBACK: void libusb_transfer_cb_fn ( libusb_transfer* transfer ) ;
+
+STRUCT: libusb_transfer
+ { dev_handle libusb_device_handle* }
+ { flags uint8_t }
+ { endpoint uchar }
+ { type uchar }
+ { timeout uint }
+ { status libusb_transfer_status }
+ { length int }
+ { actual_length int }
+ { callback libusb_transfer_cb_fn }
+ { user_data void* }
+ { buffer uchar* }
+ { num_iso_packets int }
+ { iso_packet_desc libusb_iso_packet_descriptor[0] } ;
+
+FUNCTION: int libusb_init ( libusb_context** ctx ) ;
+FUNCTION: void libusb_exit ( libusb_context* ctx ) ;
+FUNCTION: void libusb_set_debug ( libusb_context* ctx, int level ) ;
+
+FUNCTION: ssize_t libusb_get_device_list ( libusb_context* ctx, libusb_device*** list ) ;
+FUNCTION: void libusb_free_device_list ( libusb_device** list, int unref_devices ) ;
+FUNCTION: libusb_device* libusb_ref_device ( libusb_device* dev ) ;
+FUNCTION: void libusb_unref_device ( libusb_device* dev ) ;
+
+FUNCTION: int libusb_get_configuration ( libusb_device_handle* dev, int* config ) ;
+FUNCTION: int libusb_get_device_descriptor ( libusb_device* dev, libusb_device_descriptor* desc ) ;
+FUNCTION: int libusb_get_active_config_descriptor ( libusb_device* dev, libusb_config_descriptor** config ) ;
+FUNCTION: int libusb_get_config_descriptor ( libusb_device* dev, uint8_t config_index, libusb_config_descriptor** config ) ;
+FUNCTION: int libusb_get_config_descriptor_by_value ( libusb_device* dev, uint8_t bConfigurationValue, libusb_config_descriptor** config ) ;
+FUNCTION: void libusb_free_config_descriptor ( libusb_config_descriptor* config ) ;
+FUNCTION: uint8_t libusb_get_bus_number ( libusb_device* dev ) ;
+FUNCTION: uint8_t libusb_get_device_address ( libusb_device* dev ) ;
+FUNCTION: int libusb_get_max_packet_size ( libusb_device* dev, uchar endpoint ) ;
+
+FUNCTION: int libusb_open ( libusb_device* dev, libusb_device_handle** handle ) ;
+FUNCTION: void libusb_close ( libusb_device_handle* dev_handle ) ;
+FUNCTION: libusb_device* libusb_get_device ( libusb_device_handle* dev_handle ) ;
+
+FUNCTION: int libusb_set_configuration ( libusb_device_handle* dev, int configuration ) ;
+FUNCTION: int libusb_claim_interface ( libusb_device_handle* dev, int iface ) ;
+FUNCTION: int libusb_release_interface ( libusb_device_handle* dev, int iface ) ;
+
+FUNCTION: libusb_device_handle* libusb_open_device_with_vid_pid ( libusb_context* ctx, uint16_t vendor_id, uint16_t product_id ) ;
+
+FUNCTION: int libusb_set_interface_alt_setting ( libusb_device_handle* dev, int interface_number, int alternate_setting ) ;
+FUNCTION: int libusb_clear_halt ( libusb_device_handle* dev, uchar endpoint ) ;
+FUNCTION: int libusb_reset_device ( libusb_device_handle* dev ) ;
+
+FUNCTION: int libusb_kernel_driver_active ( libusb_device_handle* dev, int interface ) ;
+FUNCTION: int libusb_detach_kernel_driver ( libusb_device_handle* dev, int interface ) ;
+FUNCTION: int libusb_attach_kernel_driver ( libusb_device_handle* dev, int interface ) ;
+
+: libusb_control_transfer_get_data ( transfer -- data )
+ buffer>> LIBUSB_CONTROL_SETUP_SIZE swap <displaced-alien> ; inline
+
+: libusb_control_transfer_get_setup ( transfer -- setup )
+ buffer>> libusb_control_setup memory>struct ; inline
+
+:: libusb_fill_control_setup ( buffer bmRequestType bRequest wValue wIndex wLength -- )
+ buffer libusb_control_setup memory>struct
+ bmRequestType >>bmRequestType
+ bRequest >>bRequest
+ wValue libusb_cpu_to_le16 >>wValue
+ wIndex libusb_cpu_to_le16 >>wIndex
+ wLength libusb_cpu_to_le16 >>wLength drop ; inline
+
+FUNCTION: libusb_transfer* libusb_alloc_transfer ( int iso_packets ) ;
+FUNCTION: int libusb_submit_transfer ( libusb_transfer* transfer ) ;
+FUNCTION: int libusb_cancel_transfer ( libusb_transfer* transfer ) ;
+FUNCTION: void libusb_free_transfer ( libusb_transfer* transfer ) ;
+
+:: libusb_fill_control_transfer ( transfer dev_handle buffer callback user_data timeout -- )
+ transfer
+ dev_handle >>dev_handle
+ 0 >>endpoint
+ LIBUSB_TRANSFER_TYPE_CONTROL >>type
+ timeout >>timeout
+ buffer >>buffer
+ user_data >>user_data
+ callback >>callback
+
+ buffer [
+ libusb_control_setup memory>struct wLength>> LIBUSB_CONTROL_SETUP_SIZE +
+ ] [ 0 ] if* >>length drop ; inline
+
+:: libusb_fill_bulk_transfer ( transfer dev_handle endpoint buffer length callback user_data timeout -- )
+ transfer
+ dev_handle >>dev_handle
+ endpoint >>endpoint
+ LIBUSB_TRANSFER_TYPE_BULK >>type
+ timeout >>timeout
+ buffer >>buffer
+ length >>length
+ user_data >>user_data
+ callback >>callback
+ drop ; inline
+
+:: libusb_fill_interrupt_transfer ( transfer dev_handle endpoint buffer length callback user_data timeout -- )
+ transfer
+ dev_handle >>dev_handle
+ endpoint >>endpoint
+ LIBUSB_TRANSFER_TYPE_INTERRUPT >>type
+ timeout >>timeout
+ buffer >>buffer
+ length >>length
+ user_data >>user_data
+ callback >>callback
+ drop ; inline
+
+:: libusb_fill_iso_transfer ( transfer dev_handle endpoint buffer length num_iso_packets callback user_data timeout -- )
+ transfer
+ dev_handle >>dev_handle
+ endpoint >>endpoint
+ LIBUSB_TRANSFER_TYPE_ISOCHRONOUS >>type
+ timeout >>timeout
+ buffer >>buffer
+ length >>length
+ num_iso_packets >>num_iso_packets
+ user_data >>user_data
+ callback >>callback
+ drop ; inline
+
+: libusb_set_iso_packet_lengths ( transfer length -- )
+ [ [ iso_packet_desc>> >c-ptr ]
+ [ num_iso_packets>> ] bi
+ <direct-libusb_iso_packet_descriptor-array>
+ ] dip [ >>length drop ] curry each ; inline
+
+:: libusb_get_iso_packet_buffer ( transfer packet -- data )
+ packet transfer num_iso_packets>> >=
+ [ f ]
+ [
+ transfer
+ [ iso_packet_desc>> >c-ptr ]
+ [ num_iso_packets>> ] bi
+ <direct-libusb_iso_packet_descriptor-array> 0
+ [ length>> + ] reduce
+ transfer buffer>> <displaced-alien>
+ ] if ;
+
+:: libusb_get_iso_packet_buffer_simple ( transfer packet -- data )
+ packet transfer num_iso_packets>> >=
+ [ f ]
+ [
+ 0 transfer
+ [ iso_packet_desc>> >c-ptr ]
+ [ num_iso_packets>> ] bi
+ <direct-libusb_iso_packet_descriptor-array> nth
+ length>> packet *
+ transfer buffer>> <displaced-alien>
+ ] if ;
+
+FUNCTION: int libusb_control_transfer ( libusb_device_handle* dev_handle,
+ uint8_t request_type, uint8_t request, uint16_t value, uint16_t index,
+ uchar* data, uint16_t length, uint timeout ) ;
+
+FUNCTION: int libusb_bulk_transfer ( libusb_device_handle* dev_handle,
+ uchar endpoint, uchar* data, int length,
+ int* actual_length, uint timeout ) ;
+
+FUNCTION: int libusb_interrupt_transfer ( libusb_device_handle* dev_handle,
+ uchar endpoint, uchar* data, int length,
+ int* actual_length, int timeout ) ;
+
+:: libusb_get_descriptor ( dev desc_type desc_index data length -- int )
+ dev LIBUSB_ENDPOINT_IN LIBUSB_REQUEST_GET_DESCRIPTOR
+ desc_type 8 shift desc_index bitor 0 data
+ length 1000 libusb_control_transfer ; inline
+
+:: libusb_get_string_descriptor ( dev desc_index langid data length -- int )
+ dev LIBUSB_ENDPOINT_IN LIBUSB_REQUEST_GET_DESCRIPTOR
+ LIBUSB_DT_STRING 8 shift desc_index bitor
+ langid data length 1000 libusb_control_transfer ; inline
+
+FUNCTION: int libusb_get_string_descriptor_ascii ( libusb_device_handle* dev,
+ uint8_t index,
+ uchar* data,
+ int length ) ;
+
+FUNCTION: int libusb_try_lock_events ( libusb_context* ctx ) ;
+FUNCTION: void libusb_lock_events ( libusb_context* ctx ) ;
+FUNCTION: void libusb_unlock_events ( libusb_context* ctx ) ;
+FUNCTION: int libusb_event_handling_ok ( libusb_context* ctx ) ;
+FUNCTION: int libusb_event_handler_active ( libusb_context* ctx ) ;
+FUNCTION: void libusb_lock_event_waiters ( libusb_context* ctx ) ;
+FUNCTION: void libusb_unlock_event_waiters ( libusb_context* ctx ) ;
+FUNCTION: int libusb_wait_for_event ( libusb_context* ctx, timeval* tv ) ;
+FUNCTION: int libusb_handle_events_timeout ( libusb_context* ctx, timeval* tv ) ;
+FUNCTION: int libusb_handle_events ( libusb_context* ctx ) ;
+FUNCTION: int libusb_handle_events_locked ( libusb_context* ctx, timeval* tv ) ;
+FUNCTION: int libusb_get_next_timeout ( libusb_context* ctx, timeval* tv ) ;
+
+STRUCT: libusb_pollfd
+ { fd int }
+ { events short } ;
+
+CALLBACK: void libusb_pollfd_added_cb ( int fd, short events, void* user_data ) ;
+CALLBACK: void libusb_pollfd_removed_cb ( int fd, void* user_data ) ;
+
+FUNCTION: libusb_pollfd** libusb_get_pollfds ( libusb_context* ctx ) ;
+FUNCTION: void libusb_set_pollfd_notifiers ( libusb_context* ctx,
+ libusb_pollfd_added_cb added_cb,
+ libusb_pollfd_removed_cb removed_cb,
+ void* user_data ) ;
--- /dev/null
+Bindings to libusb
! Functions
-FUNCTION: void LLVMDisposeMessage ( char* Message ) ;
+FUNCTION: void LLVMDisposeMessage ( c-string Message ) ;
-FUNCTION: LLVMModuleRef LLVMModuleCreateWithName ( char* ModuleID ) ;
+FUNCTION: LLVMModuleRef LLVMModuleCreateWithName ( c-string ModuleID ) ;
-FUNCTION: int LLVMAddTypeName ( LLVMModuleRef M, char* Name, LLVMTypeRef Ty ) ;
+FUNCTION: int LLVMAddTypeName ( LLVMModuleRef M, c-string Name, LLVMTypeRef Ty ) ;
FUNCTION: void LLVMDisposeModule ( LLVMModuleRef M ) ;
FUNCTION: void LLVMGetParams ( LLVMValueRef Fn, LLVMValueRef* Params ) ;
FUNCTION: LLVMValueRef
-LLVMAddFunction ( LLVMModuleRef M, char* Name, LLVMTypeRef FunctionTy ) ;
+LLVMAddFunction ( LLVMModuleRef M, c-string Name, LLVMTypeRef FunctionTy ) ;
FUNCTION: LLVMValueRef LLVMGetFirstFunction ( LLVMModuleRef M ) ;
FUNCTION: void LLVMSetFunctionCallConv ( LLVMValueRef Fn, unsigned CC ) ;
FUNCTION: LLVMBasicBlockRef
-LLVMAppendBasicBlock ( LLVMValueRef Fn, char* Name ) ;
+LLVMAppendBasicBlock ( LLVMValueRef Fn, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMGetBasicBlockParent ( LLVMBasicBlockRef BB ) ;
! Values
FUNCTION: LLVMTypeRef LLVMTypeOf ( LLVMValueRef Val ) ;
-FUNCTION: char* LLVMGetValueName ( LLVMValueRef Val ) ;
-FUNCTION: void LLVMSetValueName ( LLVMValueRef Val, char* Name ) ;
+FUNCTION: c-string LLVMGetValueName ( LLVMValueRef Val ) ;
+FUNCTION: void LLVMSetValueName ( LLVMValueRef Val, c-string Name ) ;
FUNCTION: void LLVMDumpValue ( LLVMValueRef Val ) ;
! Instruction Builders
( LLVMBuilderRef Builder, LLVMValueRef V, LLVMBasicBlockRef Else, unsigned NumCases ) ;
FUNCTION: LLVMValueRef LLVMBuildInvoke
( LLVMBuilderRef Builder, LLVMValueRef Fn, LLVMValueRef* Args, unsigned NumArgs,
- LLVMBasicBlockRef Then, LLVMBasicBlockRef Catch, char* Name ) ;
+ LLVMBasicBlockRef Then, LLVMBasicBlockRef Catch, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildUnwind
( LLVMBuilderRef Builder ) ;
FUNCTION: LLVMValueRef LLVMBuildUnreachable
! IB Arithmetic
FUNCTION: LLVMValueRef LLVMBuildAdd
-( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildSub
-( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildMul
-( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildUDiv
-( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildSDiv
-( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildFDiv
-( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildURem
-( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildSRem
-( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildFRem
-( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildShl
-( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildLShr
-( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildAShr
-( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildAnd
-( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildOr
-( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildXor
-( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildNeg
-( LLVMBuilderRef Builder, LLVMValueRef V, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef V, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildNot
-( LLVMBuilderRef Builder, LLVMValueRef V, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef V, c-string Name ) ;
! IB Memory
FUNCTION: LLVMValueRef LLVMBuildMalloc
-( LLVMBuilderRef Builder, LLVMTypeRef Ty, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMTypeRef Ty, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildArrayMalloc
-( LLVMBuilderRef Builder, LLVMTypeRef Ty, LLVMValueRef Val, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMTypeRef Ty, LLVMValueRef Val, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildAlloca
-( LLVMBuilderRef Builder, LLVMTypeRef Ty, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMTypeRef Ty, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildArrayAlloca
-( LLVMBuilderRef Builder, LLVMTypeRef Ty, LLVMValueRef Val, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMTypeRef Ty, LLVMValueRef Val, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildFree
( LLVMBuilderRef Builder, LLVMValueRef PointerVal ) ;
FUNCTION: LLVMValueRef LLVMBuildLoad
-( LLVMBuilderRef Builder, LLVMValueRef PointerVal, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef PointerVal, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildStore
( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMValueRef Ptr ) ;
FUNCTION: LLVMValueRef LLVMBuildGEP
( LLVMBuilderRef B, LLVMValueRef Pointer, LLVMValueRef* Indices,
- unsigned NumIndices, char* Name ) ;
+ unsigned NumIndices, c-string Name ) ;
! IB Casts
FUNCTION: LLVMValueRef LLVMBuildTrunc
-( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildZExt
-( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildSExt
-( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildFPToUI
-( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildFPToSI
-( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildUIToFP
-( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildSIToFP
-( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildFPTrunc
-( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildFPExt
-( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildPtrToInt
-( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildIntToPtr
-( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildBitCast
-( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, c-string Name ) ;
! IB Comparisons
FUNCTION: LLVMValueRef LLVMBuildICmp
-( LLVMBuilderRef Builder, LLVMIntPredicate Op, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMIntPredicate Op, LLVMValueRef LHS, LLVMValueRef RHS, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildFCmp
-( LLVMBuilderRef Builder, LLVMRealPredicate Op, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMRealPredicate Op, LLVMValueRef LHS, LLVMValueRef RHS, c-string Name ) ;
! IB Misc Instructions
FUNCTION: LLVMValueRef LLVMBuildPhi
-( LLVMBuilderRef Builder, LLVMTypeRef Ty, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMTypeRef Ty, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildCall
-( LLVMBuilderRef Builder, LLVMValueRef Fn, LLVMValueRef* Args, unsigned NumArgs, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef Fn, LLVMValueRef* Args, unsigned NumArgs, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildSelect
-( LLVMBuilderRef Builder, LLVMValueRef If, LLVMValueRef Then, LLVMValueRef Else, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef If, LLVMValueRef Then, LLVMValueRef Else, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildVAArg
-( LLVMBuilderRef Builder, LLVMValueRef List, LLVMTypeRef Ty, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef List, LLVMTypeRef Ty, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildExtractElement
-( LLVMBuilderRef Builder, LLVMValueRef VecVal, LLVMValueRef Index, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef VecVal, LLVMValueRef Index, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildInsertElement
-( LLVMBuilderRef Builder, LLVMValueRef VecVal, LLVMValueRef EltVal, LLVMValueRef Index, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef VecVal, LLVMValueRef EltVal, LLVMValueRef Index, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildShuffleVector
-( LLVMBuilderRef Builder, LLVMValueRef V1, LLVMValueRef V2, LLVMValueRef Mask, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef V1, LLVMValueRef V2, LLVMValueRef Mask, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildExtractValue
-( LLVMBuilderRef Builder, LLVMValueRef AggVal, unsigned Index, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef AggVal, unsigned Index, c-string Name ) ;
FUNCTION: LLVMValueRef LLVMBuildInsertValue
-( LLVMBuilderRef Builder, LLVMValueRef AggVal, LLVMValueRef EltVal, unsigned Index, char* Name ) ;
+( LLVMBuilderRef Builder, LLVMValueRef AggVal, LLVMValueRef EltVal, unsigned Index, c-string Name ) ;
! Memory Buffers/Bit Reader
FUNCTION: int LLVMCreateMemoryBufferWithContentsOfFile
-( char* Path, LLVMMemoryBufferRef* OutMemBuf, char** OutMessage ) ;
+( c-string Path, LLVMMemoryBufferRef* OutMemBuf, c-string* OutMessage ) ;
FUNCTION: void LLVMDisposeMemoryBuffer ( LLVMMemoryBufferRef MemBuf ) ;
LIBRARY: LLVMBitReader
FUNCTION: int LLVMParseBitcode
-( LLVMMemoryBufferRef MemBuf, LLVMModuleRef* OutModule, char** OutMessage ) ;
+( LLVMMemoryBufferRef MemBuf, LLVMModuleRef* OutModule, c-string* OutMessage ) ;
FUNCTION: int LLVMGetBitcodeModuleProvider
-( LLVMMemoryBufferRef MemBuf, LLVMModuleProviderRef* OutMP, char** OutMessage ) ;
+( LLVMMemoryBufferRef MemBuf, LLVMModuleProviderRef* OutMP, c-string* OutMessage ) ;
( LLVMGenericValueRef GenVal, int IsSigned ) ;
FUNCTION: int LLVMCreateExecutionEngine
-( LLVMExecutionEngineRef *OutEE, LLVMModuleProviderRef MP, char** OutError ) ;
+( LLVMExecutionEngineRef *OutEE, LLVMModuleProviderRef MP, c-string* OutError ) ;
FUNCTION: int LLVMCreateJITCompiler
-( LLVMExecutionEngineRef* OutJIT, LLVMModuleProviderRef MP, unsigned OptLevel, char** OutError ) ;
+( LLVMExecutionEngineRef* OutJIT, LLVMModuleProviderRef MP, unsigned OptLevel, c-string* OutError ) ;
FUNCTION: void LLVMDisposeExecutionEngine ( LLVMExecutionEngineRef EE ) ;
FUNCTION: void LLVMAddModuleProvider ( LLVMExecutionEngineRef EE, LLVMModuleProviderRef MP ) ;
FUNCTION: int LLVMRemoveModuleProvider
-( LLVMExecutionEngineRef EE, LLVMModuleProviderRef MP, LLVMModuleRef* OutMod, char** OutError ) ;
+( LLVMExecutionEngineRef EE, LLVMModuleProviderRef MP, LLVMModuleRef* OutMod, c-string* OutError ) ;
FUNCTION: int LLVMFindFunction
-( LLVMExecutionEngineRef EE, char* Name, LLVMValueRef* OutFn ) ;
+( LLVMExecutionEngineRef EE, c-string Name, LLVMValueRef* OutFn ) ;
FUNCTION: void* LLVMGetPointerToGlobal ( LLVMExecutionEngineRef EE, LLVMValueRef Global ) ;
bindings
-unportable
+untested
M: pointer (>tref)* type>> (>tref) 0 LLVMPointerType ;
M: pointer clean* type>> clean ;
M: pointer (tref>)* swap LLVMGetElementType (tref>) >>type ;
-M: pointer c-type type>> 8 <integer> = "char*" "void*" ? ;
+M: pointer c-type type>> 8 <integer> = "c-string" "void*" ? ;
TUPLE: vector < enclosing size type ;
: <vector> ( s t -- o )
IN: llvm.wrappers
-: llvm-throw ( char* -- )
+: llvm-throw ( c-string -- )
[ utf8 alien>string ] [ LLVMDisposeMessage ] bi throw ;
: <dispose> ( alien class -- disposable ) new swap >>value ;
--- /dev/null
+Erik Charlebois
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax math ;
+IN: math.splines
+
+HELP: <bezier-curve>
+{ $values
+ { "control-points" "sequence of control points same dimension" }
+ { "polynomials" "sequence of polynomials for each dimension" }
+}
+{ $description "Creates bezier curve polynomials for the given control points." } ;
+
+HELP: <catmull-rom-spline>
+{ $values
+ { "points" "points on the spline" } { "m0" "initial tangent vector" } { "mn" "final tangent vector" }
+ { "polynomials-sequence" "sequence of sequences of polynomials" }
+}
+{ $description "Creates a sequence of cubic hermite curves (each a sequence of polynomials) passing through the given points and generating tangents for C1 continuity." } ;
+
+HELP: <cubic-hermite-curve>
+{ $values
+ { "p0" "start point" } { "m0" "start tangent" } { "p1" "end point" } { "m1" "end tangent" }
+ { "polynomials" "sequence of polynomials" }
+}
+{ $description "Creates a sequence of polynomials (one per dimension) for the curve passing through " { $emphasis "p0" } " and " { $emphasis "p1" } "." } ;
+
+HELP: <cubic-hermite-spline>
+{ $values
+ { "point-tangent-pairs" "sequence of point and tangent pairs" }
+ { "polynomials-sequence" "sequence of sequences of polynomials" }
+}
+{ $description "Creates a sequence of cubic hermite curves (each a sequence of polynomials) passing through the given points with the given tangents." } ;
+
+HELP: <kochanek-bartels-curve>
+{ $values
+ { "points" "points on the spline" } { "m0" "start tangent" } { "mn" "end tangent" } { "tension" number } { "bias" number } { "continuity" number }
+ { "polynomials-sequence" "sequence of sequence of polynomials" }
+}
+{ $description "Creates a sequence of cubic hermite curves (each a sequence of polynomials) passing through the given points, generating tangents with the given tuning parameters." } ;
+
+ARTICLE: "math.splines" "Common parametric curves."
+"The curve creating functions create sequences of polynomials, one for each degree of the input points. The spline creating functions create sequences of these curve polynomial sequences. The " { $vocab-link "math.splines.viewer" } " vocabulary provides a gadget to evaluate the generated polynomials and view the results.";
+
+ABOUT: "math.splines"
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators kernel locals math math.combinatorics
+math.polynomials opengl.gl sequences ui.gadgets ui.gadgets.panes
+ui.render arrays grouping math.vectors assocs
+ui.gestures ;
+IN: math.splines
+
+<PRIVATE
+:: bernstein-polynomial-ith ( n i -- p )
+ n i nCk { 0 1 } i p^ { 1 -1 } n i - p^ p* n*p ;
+
+:: hermite-polynomial ( p0 m0 p1 m1 -- poly )
+ p0
+ m0
+ -3 p0 * -2 m0 * + 3 p1 * + m1 neg +
+ 2 p0 * m0 + -2 p1 * + m1 +
+ 4array ;
+
+:: kochanek-bartels-coefficients ( tension bias continuity -- s1 d1 s2 d2 )
+ 1 tension -
+ [
+ 1 bias +
+ [ 1 continuity + * * 2 / ]
+ [ 1 continuity - * * 2 / ] 2bi
+ ]
+ [
+ 1 bias -
+ [ 1 continuity - * * 2 / ]
+ [ 1 continuity + * * 2 / ] 2bi
+ ] bi ;
+
+:: kochanek-bartels-tangents ( points m0 mn c1 c2 -- tangents )
+ points 3 clump [
+ first3 :> ( pi-1 pi pi+1 )
+ pi pi-1 v- c1 v*n
+ pi+1 pi v- c2 v*n v+
+ ] map
+ m0 prefix
+ mn suffix ;
+PRIVATE>
+
+:: <bezier-curve> ( control-points -- polynomials )
+ control-points
+ [ length 1 - ]
+ [ first length [ { 0 } ] replicate ]
+ bi :> ( n acc )
+
+ control-points [| pt i |
+ n i bernstein-polynomial-ith :> poly
+ pt [| v j |
+ j acc [ v poly n*p p+ ] change-nth
+ ] each-index
+ ] each-index
+ acc ;
+
+:: <cubic-hermite-curve> ( p0 m0 p1 m1 -- polynomials )
+ p0 length iota [
+ {
+ [ p0 nth ] [ m0 nth ]
+ [ p1 nth ] [ m1 nth ]
+ } cleave
+ hermite-polynomial
+ ] map ;
+
+<PRIVATE
+: (cubic-hermite-spline) ( point-in-out-triplets -- polynomials-sequence )
+ 2 clump [
+ first2 [ first2 ] [ [ first ] [ third ] bi ] bi* <cubic-hermite-curve>
+ ] map ;
+PRIVATE>
+
+: <cubic-hermite-spline> ( point-tangent-pairs -- polynomials-sequence )
+ 2 clump [ first2 [ first2 ] bi@ <cubic-hermite-curve> ] map ;
+
+:: <kochanek-bartels-curve> ( points m0 mn tension bias continuity -- polynomials-sequence )
+ tension bias continuity kochanek-bartels-coefficients :> ( s1 d1 s2 d2 )
+ points m0 mn
+ [ s1 s2 kochanek-bartels-tangents ]
+ [ d1 d2 kochanek-bartels-tangents ] 3bi :> ( in out )
+ points in out [ 3array ] 3map (cubic-hermite-spline) ;
+
+: <catmull-rom-spline> ( points m0 mn -- polynomials-sequence )
+ 0 0 0 <kochanek-bartels-curve> ;
--- /dev/null
+Common parametric curves
--- /dev/null
+Erik Charlebois
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: locals math.splines math.splines.viewer arrays ;
+IN: math.splines.testing
+
+: test1 ( -- )
+ {
+ { { 0 0 } { 0 200 } }
+ { { 100 50 } { 0 -200 } }
+ { { 300 300 } { 500 200 } }
+ { { 400 400 } { 300 0 } }
+ } <cubic-hermite-spline> { 50 100 } 4 spline. ;
+
+: test2 ( -- )
+ {
+ { 50 50 }
+ { 100 100 }
+ { 300 200 }
+ { 350 0 }
+ { 400 400 }
+ } { 0 100 } { 100 0 } <catmull-rom-spline> { 100 50 } 50 spline. ;
+
+:: test3 ( x y z -- )
+ {
+ { 100 50 }
+ { 200 350 }
+ { 300 50 }
+ } { 0 100 } { 0 -100 } x y z <kochanek-bartels-curve> { 50 50 } 1000 spline. ;
+
+: test4 ( -- )
+ {
+ { 0 5 }
+ { 0.5 3 }
+ { 10 10 }
+ { 12 4 }
+ { 15 5 }
+ } <bezier-curve> 1array { 100 100 } 100 spline. ;
+
+: test-splines ( -- )
+ test1 test2
+ 1 0 0 test3
+ -1 0 0 test3
+ 0 1 0 test3
+ 0 -1 0 test3
+ 0 0 1 test3
+ 0 0 -1 test3
+ test4 ;
+
+
--- /dev/null
+Erik Charlebois
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel locals math math.order math.polynomials
+math.splines opengl.gl sequences ui.gadgets ui.gadgets.panes ui.render
+arrays ;
+IN: math.splines.viewer
+
+<PRIVATE
+: eval-polynomials ( polynomials-seq n -- xy-sequence )
+ [
+ [ 1 + iota ] keep [
+ /f swap [ polyval ] with map
+ ] curry with map
+ ] curry map concat ;
+PRIVATE>
+
+TUPLE: spline-gadget < gadget polynomials steps spline-dim ;
+
+M: spline-gadget pref-dim* spline-dim>> ;
+
+M:: spline-gadget draw-gadget* ( gadget -- )
+ 0 0 0 glColor3f
+
+ gadget [ polynomials>> ] [ steps>> ] bi eval-polynomials :> pts
+
+ pts [ first ] [ max ] map-reduce :> x-max
+ pts [ first ] [ min ] map-reduce :> x-min
+ pts [ second ] [ max ] map-reduce :> y-max
+ pts [ second ] [ min ] map-reduce :> y-min
+
+ pts [
+ [ first x-min - x-max x-min - / gadget spline-dim>> first * ]
+ [ second y-min - y-max y-min - / gadget spline-dim>> second * ] bi 2array
+ ] map :> pts
+
+ GL_LINE_STRIP glBegin
+ pts [
+ first2 neg gadget spline-dim>> second + glVertex2f
+ ] each
+ glEnd ;
+
+:: <spline-gadget> ( polynomials dim steps -- gadget )
+ spline-gadget new
+ dim >>spline-dim
+ polynomials >>polynomials
+ steps >>steps ;
+
+: spline. ( curve dim steps -- )
+ <spline-gadget> gadget. ;
IN: math.transforms.fft
HELP: fft
-{ $values { "seq" sequence } { "seq" sequence } }
+{ $values { "seq" sequence } { "seq'" sequence } }
{ $description "Fast Fourier transform function." } ;
: omega ( n -- n' )
recip -2 pi i* * * exp ;
-: twiddle ( seq -- seq )
+: twiddle ( seq -- seq' )
dup length [ omega ] [ n^v ] bi v* ;
PRIVATE>
DEFER: fft
-: two ( seq -- seq )
+: two ( seq -- seq' )
fft 2 v/n dup append ;
<PRIVATE
-: even ( seq -- seq ) 2 group 0 <column> ;
-: odd ( seq -- seq ) 2 group 1 <column> ;
+: even ( seq -- seq' ) 2 group 0 <column> ;
+: odd ( seq -- seq' ) 2 group 1 <column> ;
-: (fft) ( seq -- seq )
+: (fft) ( seq -- seq' )
[ odd two twiddle ] [ even two ] bi v+ ;
PRIVATE>
-: fft ( seq -- seq )
+: fft ( seq -- seq' )
dup length 1 = [ (fft) ] unless ;
IN: math.transforms.haar
HELP: haar
-{ $values { "seq" sequence } { "seq" sequence } }
+{ $values { "seq" sequence } { "seq'" sequence } }
{ $description "Haar wavelet transform function." }
{ $notes "The sequence length should be a power of two." }
{ $examples { $example "USING: math.transforms.haar prettyprint ;" "{ 7 1 6 6 3 -5 4 2 } haar ." "{ 3 2 -1 -2 3 0 4 1 }" } } ;
HELP: rev-haar
-{ $values { "seq" sequence } { "seq" sequence } }
+{ $values { "seq" sequence } { "seq'" sequence } }
{ $description "Reverse Haar wavelet transform function." }
{ $notes "The sequence length should be a power of two." }
{ $examples { $example "USING: math.transforms.haar prettyprint ;" "{ 3 2 -1 -2 3 0 4 1 } rev-haar ." "{ 7 1 6 6 3 -5 4 2 }" } } ;
<PRIVATE
-: averages ( seq -- seq )
+: averages ( seq -- seq' )
[ mean ] map ;
: differences ( seq averages -- differences )
PRIVATE>
-: haar ( seq -- seq )
+: haar ( seq -- seq' )
dup length 1 <= [ haar-step haar prepend ] unless ;
-: rev-haar ( seq -- seq )
+: rev-haar ( seq -- seq' )
dup length 2 > [ halves swap rev-haar prepend ] when rev-haar-step ;
HELP: pile-align
{ $values
{ "pile" pile } { "align" "a power of two" }
- { "pile" pile }
}
{ $description "Adjusts a " { $link pile } "'s internal state so that the next call to " { $link pile-alloc } " will return a pointer aligned to " { $snippet "align" } " bytes relative to the pile's initial offset." } ;
+++ /dev/null
-unportable
-
HELP: >upsert
{ $values
{ "mdb-update-msg" "a mdb-update-msg" }
- { "mdb-update-msg" "mdb-update-msg with the upsert indicator set to t" }
}
{ $description "Marks a mdb-update-msg as upsert operation"
"(inserts object identified by the update selector if it doesn't exist in the collection)" } ;
{ $values
{ "mdb-query-msg" "a query" }
{ "index-hint" "a hint to an index" }
- { "mdb-query-msg" "modified query object" }
}
{ $description "Annotates the query with a hint to an index. "
"For detailed information see: " { $url "http://www.mongodb.org/display/DOCS/Optimizing+Mongo+Performance#OptimizingMongoPerformance-Hint" } }
{ $values
{ "mdb-query-msg" "a query" }
{ "limit#" "number of objects that should be returned at most" }
- { "mdb-query-msg" "modified query object" }
}
{ $description "Limits the number of returned objects to limit#" }
{ $examples
{ $values
{ "mdb-query-msg" "a query message" }
{ "skip#" "number of objects to skip" }
- { "mdb-query-msg" "annotated query message" }
}
{ $description "annotates a query message with a number of objects to skip when returning the results" } ;
{ $values
{ "mdb-query-msg" "a query message" }
{ "sort-quot" "a quotation with sort specifiers" }
- { "mdb-query-msg" "annotated query message" }
}
{ $description "annotates the query message for sort specifiers" } ;
USING: accessors assocs bson.reader bson.writer byte-arrays
-byte-vectors combinators formatting fry io io.binary io.encodings.private
-io.encodings.binary io.encodings.string io.encodings.utf8 io.encodings.utf8.private io.files
-kernel locals math mongodb.msg namespaces sequences uuid bson.writer.private ;
-
-IN: alien.c-types
-
-M: byte-vector byte-length length ;
-
+byte-vectors combinators formatting fry io io.binary
+io.encodings.private io.encodings.binary io.encodings.string
+io.encodings.utf8 io.encodings.utf8.private io.files kernel
+locals math mongodb.msg namespaces sequences uuid
+bson.writer.private ;
IN: mongodb.operations
<PRIVATE
! Copyright (C) 2007, 2008, 2009 Alex Chapman, 2009 Diego Martinelli
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors ascii assocs biassocs combinators hashtables kernel lists literals math namespaces make multiline openal parser sequences splitting strings synth synth.buffers ;
+USING: accessors ascii assocs biassocs combinators hashtables kernel lists literals math namespaces make multiline openal openal.alut parser sequences splitting strings synth synth.buffers ;
IN: morse
ERROR: no-morse-ch ch ;
-USING: alien.c-types alien.syntax io io.encodings.utf16n
-io.encodings.utf8 io.files kernel namespaces sequences system threads
+! Copyright (C) 2009 Phil Dawes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types alien.strings alien.syntax io
+io.encodings.utf8 io.files kernel sequences system threads
unix.utilities ;
IN: native-thread-test
-FUNCTION: void* start_standalone_factor_in_new_thread ( int argc, char** argv ) ;
-
-HOOK: native-string-encoding os ( -- encoding )
-M: windows native-string-encoding utf16n ;
-M: unix native-string-encoding utf8 ;
+FUNCTION: void* start_standalone_factor_in_new_thread ( int argc, c-string* argv ) ;
: start-vm-in-os-thread ( args -- threadhandle )
- \ vm get-global prefix
+ vm prefix
[ length ] [ native-string-encoding strings>alien ] bi
- start_standalone_factor_in_new_thread ;
+ start_standalone_factor_in_new_thread ;
: start-tetris-in-os-thread ( -- )
- { "-run=tetris" } start-vm-in-os-thread drop ;
+ { "-run=tetris" } start-vm-in-os-thread drop ;
+
+: start-test-thread-in-os-thread ( -- )
+ { "-run=native-thread-test" } start-vm-in-os-thread drop ;
-: start-testthread-in-os-thread ( -- )
- { "-run=native-thread-test" } start-vm-in-os-thread drop ;
-
-: testthread ( -- )
- "/tmp/hello" utf8 [ "hello!\n" write ] with-file-appender 5000000 sleep ;
+: test-thread ( -- )
+ "/tmp/hello" utf8 [ "hello!\n" write ] with-file-appender 5000000 sleep ;
-MAIN: testthread
+MAIN: test-thread
{ [ os macosx? ] [ "libogg.0.dylib" ] }
{ [ os unix? ] [ "libogg.so" ] }
} cond "cdecl" add-library
+
+"ogg" deploy-library
>>
LIBRARY: ogg
;
STRUCT: th-comment
- { user-comments char** }
+ { user-comments c-string* }
{ comment-lengths int* }
{ comments int }
- { vendor char* }
+ { vendor c-string }
;
TYPEDEF: uchar[64] th-quant-base
;
LIBRARY: theoradec
-FUNCTION: char* th_version_string ( ) ;
+FUNCTION: c-string 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: 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_add ( th-comment* tc, c-string comment ) ;
+FUNCTION: void th_comment_add_tag ( th-comment* tc, c-string tag, c-string value ) ;
+FUNCTION: c-string th_comment_query ( th-comment* tc, c-string tag, int count ) ;
+FUNCTION: int th_comment_query_count ( th-comment* tc, c-string tag ) ;
FUNCTION: void th_comment_clear ( th-comment* tc ) ;
CONSTANT: TH-ENCCTL-SET-HUFFMAN-CODES 0
{ [ os macosx? ] [ "libvorbis.0.dylib" ] }
{ [ os unix? ] [ "libvorbis.so" ] }
} cond "cdecl" add-library
+
+"vorbis" deploy-library
>>
LIBRARY: vorbis
;
STRUCT: vorbis-comment
- { usercomments char** }
+ { usercomments c-string* }
{ comment_lengths int* }
{ comments int }
- { vendor char* }
+ { vendor c-string }
;
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_add ( vorbis-comment* vc, c-string comment ) ;
+FUNCTION: void vorbis_comment_add_tag ( vorbis-comment* vc, c-string tag, c-string contents ) ;
+FUNCTION: c-string vorbis_comment_query ( vorbis-comment* vc, c-string tag, int count ) ;
+FUNCTION: int vorbis_comment_query_count ( vorbis-comment* vc, c-string 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 ) ;
--- /dev/null
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors arrays alien system combinators
+alien.syntax namespaces alien.c-types sequences vocabs.loader
+shuffle openal openal.alut.backend alien.libraries generalizations
+specialized-arrays alien.destructors ;
+FROM: alien.c-types => float short ;
+SPECIALIZED-ARRAY: uint
+IN: openal.alut
+
+<< "alut" {
+ { [ os windows? ] [ "alut.dll" ] }
+ { [ os macosx? ] [
+ "/System/Library/Frameworks/OpenAL.framework/OpenAL"
+ ] }
+ { [ os unix? ] [ "libalut.so" ] }
+ } cond "cdecl" add-library >>
+
+<< os macosx? [ "alut" deploy-library ] unless >>
+
+LIBRARY: alut
+
+CONSTANT: ALUT_API_MAJOR_VERSION 1
+CONSTANT: ALUT_API_MINOR_VERSION 1
+CONSTANT: ALUT_ERROR_NO_ERROR 0
+CONSTANT: ALUT_ERROR_OUT_OF_MEMORY HEX: 200
+CONSTANT: ALUT_ERROR_INVALID_ENUM HEX: 201
+CONSTANT: ALUT_ERROR_INVALID_VALUE HEX: 202
+CONSTANT: ALUT_ERROR_INVALID_OPERATION HEX: 203
+CONSTANT: ALUT_ERROR_NO_CURRENT_CONTEXT HEX: 204
+CONSTANT: ALUT_ERROR_AL_ERROR_ON_ENTRY HEX: 205
+CONSTANT: ALUT_ERROR_ALC_ERROR_ON_ENTRY HEX: 206
+CONSTANT: ALUT_ERROR_OPEN_DEVICE HEX: 207
+CONSTANT: ALUT_ERROR_CLOSE_DEVICE HEX: 208
+CONSTANT: ALUT_ERROR_CREATE_CONTEXT HEX: 209
+CONSTANT: ALUT_ERROR_MAKE_CONTEXT_CURRENT HEX: 20A
+CONSTANT: ALUT_ERROR_DESTRY_CONTEXT HEX: 20B
+CONSTANT: ALUT_ERROR_GEN_BUFFERS HEX: 20C
+CONSTANT: ALUT_ERROR_BUFFER_DATA HEX: 20D
+CONSTANT: ALUT_ERROR_IO_ERROR HEX: 20E
+CONSTANT: ALUT_ERROR_UNSUPPORTED_FILE_TYPE HEX: 20F
+CONSTANT: ALUT_ERROR_UNSUPPORTED_FILE_SUBTYPE HEX: 210
+CONSTANT: ALUT_ERROR_CORRUPT_OR_TRUNCATED_DATA HEX: 211
+CONSTANT: ALUT_WAVEFORM_SINE HEX: 100
+CONSTANT: ALUT_WAVEFORM_SQUARE HEX: 101
+CONSTANT: ALUT_WAVEFORM_SAWTOOTH HEX: 102
+CONSTANT: ALUT_WAVEFORM_WHITENOISE HEX: 103
+CONSTANT: ALUT_WAVEFORM_IMPULSE HEX: 104
+CONSTANT: ALUT_LOADER_BUFFER HEX: 300
+CONSTANT: ALUT_LOADER_MEMORY HEX: 301
+
+FUNCTION: ALboolean alutInit ( int* argcp, c-string* argv ) ;
+FUNCTION: ALboolean alutInitWithoutContext ( int* argcp, c-string* argv ) ;
+FUNCTION: ALboolean alutExit ( ) ;
+FUNCTION: ALenum alutGetError ( ) ;
+FUNCTION: c-string alutGetErrorString ( ALenum error ) ;
+FUNCTION: ALuint alutCreateBufferFromFile ( c-string fileName ) ;
+FUNCTION: ALuint alutCreateBufferFromFileImage ( void* data, ALsizei length ) ;
+FUNCTION: ALuint alutCreateBufferHelloWorld ( ) ;
+FUNCTION: ALuint alutCreateBufferWaveform ( ALenum waveshape, ALfloat frequency, ALfloat phase, ALfloat duration ) ;
+FUNCTION: void* alutLoadMemoryFromFile ( c-string fileName, ALenum* format, ALsizei* size, ALfloat* frequency ) ;
+FUNCTION: void* alutLoadMemoryFromFileImage ( void* data, ALsizei length, ALenum* format, ALsizei* size, ALfloat* frequency ) ;
+FUNCTION: void* alutLoadMemoryHelloWorld ( ALenum* format, ALsizei* size, ALfloat* frequency ) ;
+FUNCTION: void* alutLoadMemoryWaveform ( ALenum waveshape, ALfloat frequency, ALfloat phase, ALfloat duration, ALenum* format, ALsizei* size, ALfloat* freq ) ;
+FUNCTION: c-string alutGetMIMETypes ( ALenum loader ) ;
+FUNCTION: ALint alutGetMajorVersion ( ) ;
+FUNCTION: ALint alutGetMinorVersion ( ) ;
+FUNCTION: ALboolean alutSleep ( ALfloat duration ) ;
+
+FUNCTION: void alutUnloadWAV ( ALenum format, void* data, ALsizei size, ALsizei frequency ) ;
+
+SYMBOL: init
+
+: init-openal ( -- )
+ init get-global expired? [
+ f f alutInit 0 = [ "Could not initialize OpenAL" throw ] when
+ 1337 <alien> init set-global
+ ] when ;
+
+: exit-openal ( -- )
+ init get-global expired? [
+ alutExit 0 = [ "Could not close OpenAL" throw ] when
+ f init set-global
+ ] unless ;
+
+: create-buffer-from-file ( filename -- buffer )
+ alutCreateBufferFromFile dup AL_NONE = [
+ "create-buffer-from-file failed" throw
+ ] when ;
+
+os macosx? "openal.alut.macosx" "openal.alut.other" ? require
+
+: create-buffer-from-wav ( filename -- buffer )
+ gen-buffer dup rot load-wav-file
+ [ alBufferData ] 4 nkeep alutUnloadWAV ;
+
+: check-error ( -- )
+ alGetError dup ALUT_ERROR_NO_ERROR = [
+ drop
+ ] [
+ alGetString throw
+ ] if ;
+
--- /dev/null
+Chris Double
--- /dev/null
+USING: namespaces system ;
+IN: openal.alut.backend
+
+HOOK: load-wav-file os ( filename -- format data size frequency )
--- /dev/null
+Chris Double
--- /dev/null
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types kernel alien alien.syntax shuffle
+openal openal.alut.backend namespaces system generalizations ;
+IN: openal.alut.macosx
+
+LIBRARY: alut
+
+FUNCTION: void alutLoadWAVFile ( ALbyte* fileName, ALenum* format, void** data, ALsizei* size, ALsizei* frequency ) ;
+
+M: macosx load-wav-file ( path -- format data size frequency )
+ 0 <int> f <void*> 0 <int> 0 <int>
+ [ alutLoadWAVFile ] 4 nkeep
+ [ [ [ *int ] dip *void* ] dip *int ] dip *int ;
--- /dev/null
+Chris Double
--- /dev/null
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types alien.syntax combinators generalizations
+kernel openal openal.alut.backend ;
+IN: openal.alut.other
+
+LIBRARY: alut
+
+FUNCTION: void alutLoadWAVFile ( ALbyte* fileName, ALenum* format, void** data, ALsizei* size, ALsizei* frequency, ALboolean* looping ) ;
+
+M: object load-wav-file ( filename -- format data size frequency )
+ 0 <int> f <void*> 0 <int> 0 <int>
+ [ 0 <char> alutLoadWAVFile ] 4 nkeep
+ { [ *int ] [ *void* ] [ *int ] [ *int ] } spread ;
+++ /dev/null
-Chris Double
+++ /dev/null
-USING: namespaces system ;
-IN: openal.backend
-
-HOOK: load-wav-file os ( filename -- format data size frequency )
-! Copyright (C) 2007 Chris Double.\r
-! See http://factorcode.org/license.txt for BSD license.\r
-USING: calendar kernel openal sequences threads ;\r
-IN: openal.example\r
-\r
-: play-hello ( -- )\r
- init-openal\r
- 1 gen-sources\r
- first dup AL_BUFFER alutCreateBufferHelloWorld set-source-param\r
- source-play\r
- 1000 milliseconds sleep ;\r
- \r
-: (play-file) ( source -- )\r
- 100 milliseconds sleep\r
- dup source-playing? [ (play-file) ] [ drop ] if ;\r
-\r
-: play-file ( filename -- )\r
- init-openal\r
- create-buffer-from-file \r
- 1 gen-sources\r
- first dup [ AL_BUFFER rot set-source-param ] dip\r
- dup source-play\r
- check-error\r
- (play-file) ;\r
-\r
-: play-wav ( filename -- )\r
- init-openal\r
- create-buffer-from-wav \r
- 1 gen-sources\r
- first dup [ AL_BUFFER rot set-source-param ] dip\r
- dup source-play\r
- check-error\r
- (play-file) ;\r
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+USING: calendar kernel openal openal.alut sequences threads ;
+IN: openal.example
+
+: play-hello ( -- )
+ init-openal
+ 1 gen-sources
+ first dup AL_BUFFER alutCreateBufferHelloWorld set-source-param
+ source-play
+ 1000 milliseconds sleep ;
+
+: (play-file) ( source -- )
+ 100 milliseconds sleep
+ dup source-playing? [ (play-file) ] [ drop ] if ;
+
+: play-file ( filename -- )
+ init-openal
+ create-buffer-from-file
+ 1 gen-sources
+ first dup [ AL_BUFFER rot set-source-param ] dip
+ dup source-play
+ check-error
+ (play-file) ;
+
+: play-wav ( filename -- )
+ init-openal
+ create-buffer-from-wav
+ 1 gen-sources
+ first dup [ AL_BUFFER rot set-source-param ] dip
+ dup source-play
+ check-error
+ (play-file) ;
+++ /dev/null
-Chris Double
+++ /dev/null
-! Copyright (C) 2007 Chris Double.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types kernel alien alien.syntax shuffle
-openal openal.backend namespaces system generalizations ;
-IN: openal.macosx
-
-LIBRARY: alut
-
-FUNCTION: void alutLoadWAVFile ( ALbyte* fileName, ALenum* format, void** data, ALsizei* size, ALsizei* frequency ) ;
-
-M: macosx load-wav-file ( path -- format data size frequency )
- 0 <int> f <void*> 0 <int> 0 <int>
- [ alutLoadWAVFile ] 4 nkeep
- [ [ [ *int ] dip *void* ] dip *int ] dip *int ;
+++ /dev/null
-unportable
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors arrays alien system combinators
alien.syntax namespaces alien.c-types sequences vocabs.loader
-shuffle openal.backend alien.libraries generalizations
+shuffle alien.libraries generalizations
specialized-arrays alien.destructors ;
FROM: alien.c-types => float short ;
SPECIALIZED-ARRAY: uint
IN: openal
-<< "alut" {
- { [ os windows? ] [ "alut.dll" ] }
- { [ os macosx? ] [
- "/System/Library/Frameworks/OpenAL.framework/OpenAL"
- ] }
- { [ os unix? ] [ "libalut.so" ] }
- } cond "cdecl" add-library >>
-
<< "openal" {
{ [ os windows? ] [ "OpenAL32.dll" ] }
{ [ os macosx? ] [
{ [ os unix? ] [ "libopenal.so" ] }
} cond "cdecl" add-library >>
+<< os macosx? [ "openal" deploy-library ] unless >>
+
LIBRARY: openal
TYPEDEF: char ALboolean
DESTRUCTOR: alcCloseDevice*
DESTRUCTOR: alcDestroyContext
-LIBRARY: alut
-
-CONSTANT: ALUT_API_MAJOR_VERSION 1
-CONSTANT: ALUT_API_MINOR_VERSION 1
-CONSTANT: ALUT_ERROR_NO_ERROR 0
-CONSTANT: ALUT_ERROR_OUT_OF_MEMORY HEX: 200
-CONSTANT: ALUT_ERROR_INVALID_ENUM HEX: 201
-CONSTANT: ALUT_ERROR_INVALID_VALUE HEX: 202
-CONSTANT: ALUT_ERROR_INVALID_OPERATION HEX: 203
-CONSTANT: ALUT_ERROR_NO_CURRENT_CONTEXT HEX: 204
-CONSTANT: ALUT_ERROR_AL_ERROR_ON_ENTRY HEX: 205
-CONSTANT: ALUT_ERROR_ALC_ERROR_ON_ENTRY HEX: 206
-CONSTANT: ALUT_ERROR_OPEN_DEVICE HEX: 207
-CONSTANT: ALUT_ERROR_CLOSE_DEVICE HEX: 208
-CONSTANT: ALUT_ERROR_CREATE_CONTEXT HEX: 209
-CONSTANT: ALUT_ERROR_MAKE_CONTEXT_CURRENT HEX: 20A
-CONSTANT: ALUT_ERROR_DESTRY_CONTEXT HEX: 20B
-CONSTANT: ALUT_ERROR_GEN_BUFFERS HEX: 20C
-CONSTANT: ALUT_ERROR_BUFFER_DATA HEX: 20D
-CONSTANT: ALUT_ERROR_IO_ERROR HEX: 20E
-CONSTANT: ALUT_ERROR_UNSUPPORTED_FILE_TYPE HEX: 20F
-CONSTANT: ALUT_ERROR_UNSUPPORTED_FILE_SUBTYPE HEX: 210
-CONSTANT: ALUT_ERROR_CORRUPT_OR_TRUNCATED_DATA HEX: 211
-CONSTANT: ALUT_WAVEFORM_SINE HEX: 100
-CONSTANT: ALUT_WAVEFORM_SQUARE HEX: 101
-CONSTANT: ALUT_WAVEFORM_SAWTOOTH HEX: 102
-CONSTANT: ALUT_WAVEFORM_WHITENOISE HEX: 103
-CONSTANT: ALUT_WAVEFORM_IMPULSE HEX: 104
-CONSTANT: ALUT_LOADER_BUFFER HEX: 300
-CONSTANT: ALUT_LOADER_MEMORY HEX: 301
-
-FUNCTION: ALboolean alutInit ( int* argcp, char** argv ) ;
-FUNCTION: ALboolean alutInitWithoutContext ( int* argcp, char** argv ) ;
-FUNCTION: ALboolean alutExit ( ) ;
-FUNCTION: ALenum alutGetError ( ) ;
-FUNCTION: char* alutGetErrorString ( ALenum error ) ;
-FUNCTION: ALuint alutCreateBufferFromFile ( char* fileName ) ;
-FUNCTION: ALuint alutCreateBufferFromFileImage ( void* data, ALsizei length ) ;
-FUNCTION: ALuint alutCreateBufferHelloWorld ( ) ;
-FUNCTION: ALuint alutCreateBufferWaveform ( ALenum waveshape, ALfloat frequency, ALfloat phase, ALfloat duration ) ;
-FUNCTION: void* alutLoadMemoryFromFile ( char* fileName, ALenum* format, ALsizei* size, ALfloat* frequency ) ;
-FUNCTION: void* alutLoadMemoryFromFileImage ( void* data, ALsizei length, ALenum* format, ALsizei* size, ALfloat* frequency ) ;
-FUNCTION: void* alutLoadMemoryHelloWorld ( ALenum* format, ALsizei* size, ALfloat* frequency ) ;
-FUNCTION: void* alutLoadMemoryWaveform ( ALenum waveshape, ALfloat frequency, ALfloat phase, ALfloat duration, ALenum* format, ALsizei* size, ALfloat* freq ) ;
-FUNCTION: char* alutGetMIMETypes ( ALenum loader ) ;
-FUNCTION: ALint alutGetMajorVersion ( ) ;
-FUNCTION: ALint alutGetMinorVersion ( ) ;
-FUNCTION: ALboolean alutSleep ( ALfloat duration ) ;
-
-FUNCTION: void alutUnloadWAV ( ALenum format, void* data, ALsizei size, ALsizei frequency ) ;
-
-SYMBOL: init
-
-: init-openal ( -- )
- init get-global expired? [
- f f alutInit 0 = [ "Could not initialize OpenAL" throw ] when
- 1337 <alien> init set-global
- ] when ;
-
-: exit-openal ( -- )
- init get-global expired? [
- alutExit 0 = [ "Could not close OpenAL" throw ] when
- f init set-global
- ] unless ;
-
: gen-sources ( size -- seq )
dup <uint-array> [ alGenSources ] keep ;
: gen-buffer ( -- buffer ) 1 gen-buffers first ;
-: create-buffer-from-file ( filename -- buffer )
- alutCreateBufferFromFile dup AL_NONE = [
- "create-buffer-from-file failed" throw
- ] when ;
-
-os macosx? "openal.macosx" "openal.other" ? require
-
-: create-buffer-from-wav ( filename -- buffer )
- gen-buffer dup rot load-wav-file
- [ alBufferData ] 4 nkeep alutUnloadWAV ;
-
: queue-buffers ( source buffers -- )
[ length ] [ >uint-array ] bi alSourceQueueBuffers ;
: source-stop ( source -- ) alSourceStop ;
-: check-error ( -- )
- alGetError dup ALUT_ERROR_NO_ERROR = [
- drop
- ] [
- alGetString throw
- ] if ;
-
: source-playing? ( source -- bool )
AL_SOURCE_STATE get-source-param AL_PLAYING = ;
+++ /dev/null
-Chris Double
+++ /dev/null
-! Copyright (C) 2007 Chris Double.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types alien.syntax combinators generalizations
-kernel openal openal.backend ;
-IN: openal.other
-
-LIBRARY: alut
-
-FUNCTION: void alutLoadWAVFile ( ALbyte* fileName, ALenum* format, void** data, ALsizei* size, ALsizei* frequency, ALboolean* looping ) ;
-
-M: object load-wav-file ( filename -- format data size frequency )
- 0 <int> f <void*> 0 <int> 0 <int>
- [ 0 <char> alutLoadWAVFile ] 4 nkeep
- { [ *int ] [ *void* ] [ *int ] [ *int ] } spread ;
FUNCTION: void gluEndPolygon ( GLUtesselator* tess ) ;
FUNCTION: void gluEndSurface ( GLUnurbs* nurb ) ;
FUNCTION: void gluEndTrim ( GLUnurbs* nurb ) ;
-FUNCTION: char* gluErrorString ( GLenum error ) ;
+FUNCTION: c-string gluErrorString ( GLenum error ) ;
FUNCTION: void gluGetNurbsProperty ( GLUnurbs* nurb, GLenum property, GLfloat* data ) ;
-FUNCTION: char* gluGetString ( GLenum name ) ;
+FUNCTION: c-string gluGetString ( GLenum name ) ;
FUNCTION: void gluGetTessProperty ( GLUtesselator* tess, GLenum which, GLdouble* data ) ;
FUNCTION: void gluLoadSamplingMatrices ( GLUnurbs* nurb, GLfloat* model, GLfloat* perspective, GLint* view ) ;
FUNCTION: void gluLookAt ( GLdouble eyeX, GLdouble eyeY, GLdouble eyeZ, GLdouble centerX, GLdouble centerY, GLdouble centerZ, GLdouble upX, GLdouble upY, GLdouble upZ ) ;
-USING: accessors kernel math math.order poker poker.private
-tools.test ;
+USING: accessors kernel math math.order poker poker.private tools.test ;
IN: poker.tests
[ 134236965 ] [ "KD" >ckf ] unit-test
-! Copyright (c) 2009 Aaron Schaefer. All rights reserved.
-! Copyright (c) 2009 Doug Coleman.
+! Copyright (c) 2009 Aaron Schaefer, Doug Coleman. All rights reserved.
! The contents of this file are licensed under the Simplified BSD License
! A copy of the license is available at http://factorcode.org/license.txt
USING: accessors arrays ascii assocs binary-search combinators
PRIVATE>
: euler004 ( -- answer )
- source-004 dup cartesian-product [ product ] map prune max-palindrome ;
+ source-004 dup [ * ] cartesian-map concat prune max-palindrome ;
! [ euler004 ] 100 ave-time
! 1164 ms ave run time - 39.35 SD (100 trials)
: source-027 ( -- seq )
1000 iota [ prime? ] filter [ dup [ neg ] map append ] keep
- cartesian-product [ first2 < ] filter ;
+ cartesian-product concat [ first2 < ] filter ;
: quadratic ( b a n -- m )
dup sq -rot * + + ;
! --------
: euler029 ( -- answer )
- 2 100 [a,b] dup cartesian-product [ first2 ^ ] map prune length ;
+ 2 100 [a,b] dup [ ^ ] cartesian-map concat prune length ;
! [ euler029 ] 100 ave-time
! 704 ms ave run time - 28.07 SD (100 trials)
<PRIVATE
-: source-032a ( -- seq )
- 50 [1,b] 2000 [1,b] cartesian-product ;
-
! multiplicand/multiplier/product
-: mmp ( pair -- n )
- first2 2dup * [ number>string ] tri@ 3append string>number ;
+: mmp ( x y -- n )
+ 2dup * [ number>string ] tri@ 3append string>number ;
PRIVATE>
: euler032a ( -- answer )
- source-032a [ mmp ] map [ pandigital? ] filter products prune sum ;
+ 50 [1,b] 2000 [1,b]
+ [ mmp ] cartesian-map concat
+ [ pandigital? ] filter
+ products prune sum ;
! [ euler032a ] 10 ave-time
! 2624 ms ave run time - 131.91 SD (10 trials)
<PRIVATE
: source-033 ( -- seq )
- 10 99 [a,b] dup cartesian-product [ first2 < ] filter ;
+ 10 99 [a,b] dup cartesian-product concat [ first2 < ] filter ;
: safe? ( ax xb -- ? )
[ 10 /mod ] bi@ [ = ] dip zero? not and nip ;
: interesting-pandigitals ( -- seq )
17 candidates { 13 11 7 5 3 2 } [
- candidates swap cartesian-product [ overlap? ] filter clean
+ candidates swap cartesian-product concat
+ [ overlap? ] filter clean
] each [ add-missing-digit ] map ;
PRIVATE>
! Copyright (c) 2009 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays byte-arrays fry hints kernel math math.combinatorics
- math.functions math.parser math.primes project-euler.common sequences sets ;
+USING: arrays byte-arrays fry kernel math math.combinatorics math.functions
+ math.parser math.primes project-euler.common sequences sets ;
IN: project-euler.049
! http://projecteuler.net/index.php?section=problems&id=49
<PRIVATE
-: count-digits ( n -- byte-array )
- 10 <byte-array> [
- '[ 10 /mod _ [ 1 + ] change-nth dup 0 > ] loop drop
- ] keep ;
-
-HINTS: count-digits fixnum ;
-
-: permutations? ( n m -- ? )
- [ count-digits ] bi@ = ;
-
: collect-permutations ( seq -- seq )
[ V{ } clone ] [ dup ] bi* [
dupd '[ _ permutations? ] filter
! Through analysis, you only need to check when a and b > 90
: euler056 ( -- answer )
- 90 100 [a,b) dup cartesian-product
+ 90 100 [a,b) dup cartesian-product concat
[ first2 ^ number>digits sum ] [ max ] map-reduce ;
! [ euler056 ] 100 ave-time
--- /dev/null
+USING: project-euler.070 tools.test ;
+IN: project-euler.070.tests
+
+[ 8319823 ] [ euler070 ] unit-test
--- /dev/null
+! Copyright (c) 2010 Aaron Schaefer. All rights reserved.
+! The contents of this file are licensed under the Simplified BSD License
+! A copy of the license is available at http://factorcode.org/license.txt
+USING: arrays assocs combinators.short-circuit kernel math math.combinatorics
+ math.functions math.primes math.ranges project-euler.common sequences ;
+IN: project-euler.070
+
+! http://projecteuler.net/index.php?section=problems&id=70
+
+! DESCRIPTION
+! -----------
+
+! Euler's Totient function, φ(n) [sometimes called the phi function], is used
+! to determine the number of positive numbers less than or equal to n which are
+! relatively prime to n. For example, as 1, 2, 4, 5, 7, and 8, are all less
+! than nine and relatively prime to nine, φ(9)=6. The number 1 is considered to
+! be relatively prime to every positive number, so φ(1)=1.
+
+! Interestingly, φ(87109)=79180, and it can be seen that 87109 is a permutation
+! of 79180.
+
+! Find the value of n, 1 < n < 10^(7), for which φ(n) is a permutation of n and
+! the ratio n/φ(n) produces a minimum.
+
+
+! SOLUTION
+! --------
+
+! For n/φ(n) to be minimised, φ(n) must be as close to n as possible; that is,
+! we want to maximise φ(n). The minimal solution for n/φ(n) would be if n was
+! prime giving n/(n-1) but since n-1 never is a permutation of n it cannot be
+! prime.
+
+! The next best thing would be if n only consisted of 2 prime factors close to
+! (in this case) sqrt(10000000). Hence n = p1*p2 and we only need to search
+! through a list of known prime pairs. In addition:
+
+! φ(p1*p2) = p1*p2*(1-1/p1)(1-1/p2) = (p1-1)(p2-1)
+
+! ...so we can compute φ(n) more efficiently.
+
+<PRIVATE
+
+! NOTE: ±1000 is an arbitrary range
+: likely-prime-factors ( -- seq )
+ 7 10^ sqrt >integer 1000 [ - ] [ + ] 2bi primes-between ; inline
+
+: n-and-phi ( seq -- seq' )
+ #! ( seq = { p1, p2 } -- seq' = { n, φ(n) } )
+ [ product ] [ [ 1 - ] map product ] bi 2array ;
+
+: fit-requirements? ( seq -- ? )
+ first2 { [ drop 7 10^ < ] [ permutations? ] } 2&& ;
+
+: minimum-ratio ( seq -- n )
+ [ [ first2 / ] map [ infimum ] keep index ] keep nth first ;
+
+PRIVATE>
+
+: euler070 ( -- answer )
+ likely-prime-factors 2 all-combinations [ n-and-phi ] map
+ [ fit-requirements? ] filter minimum-ratio ;
+
+! [ euler070 ] 100 ave-time
+! 379 ms ave run time - 1.15 SD (100 trials)
+
+SOLUTION: euler070
3dup minimal-path-sum-to '[ _ + ] change-matrix ;
: (euler081) ( matrix -- n )
- dup first length iota dup cartesian-product
- [ first2 pick update-minimal-path-sum ] each
+ dup first length iota dup
+ [ pick update-minimal-path-sum ] cartesian-each
last last ;
PRIVATE>
--- /dev/null
+USING: project-euler.206 tools.test ;
+IN: project-euler.206.tests
+
+[ 1389019170 ] [ euler206 ] unit-test
--- /dev/null
+! Copyright (c) 2010 Aaron Schaefer. All rights reserved.
+! The contents of this file are licensed under the Simplified BSD License
+! A copy of the license is available at http://factorcode.org/license.txt
+USING: grouping kernel math math.ranges project-euler.common sequences ;
+IN: project-euler.206
+
+! http://projecteuler.net/index.php?section=problems&id=206
+
+! DESCRIPTION
+! -----------
+
+! Find the unique positive integer whose square has the form
+! 1_2_3_4_5_6_7_8_9_0, where each “_” is a single digit.
+
+
+! SOLUTION
+! --------
+
+! Through mathematical analysis, we know that the number must end in 00, and
+! the only way to get the last digits to be 900, is for our answer to end in
+! 30 or 70.
+
+<PRIVATE
+
+! 1020304050607080900 sqrt, rounded up to the nearest 30 ending
+CONSTANT: lo 1010101030
+
+! 1929394959697989900 sqrt, rounded down to the nearest 70 ending
+CONSTANT: hi 1389026570
+
+: form-fitting? ( n -- ? )
+ number>digits 2 group [ first ] map
+ { 1 2 3 4 5 6 7 8 9 0 } = ;
+
+: candidates ( -- seq )
+ lo lo 40 + [ hi 100 <range> ] bi@ append ;
+
+PRIVATE>
+
+: euler206 ( -- answer )
+ candidates [ sq form-fitting? ] find-last nip ;
+
+! [ euler206 ] 100 ave-time
+! 321 ms ave run time - 8.33 SD (100 trials)
+
+SOLUTION: euler206
-! Copyright (C) 2009 Jon Harper.
+! Copyright (c) 2009 Jon Harper.
! See http://factorcode.org/license.txt for BSD license.
-USING: project-euler.common math kernel sequences math.functions math.ranges prettyprint io threads math.parser locals arrays namespaces ;
+USING: arrays io kernel locals math math.functions math.parser math.ranges
+ namespaces prettyprint project-euler.common sequences threads ;
IN: project-euler.255
! http://projecteuler.net/index.php?section=problems&id=255
! DESCRIPTION
! -----------
-! We define the rounded-square-root of a positive integer n as the square root of n rounded to the nearest integer.
-!
-! The following procedure (essentially Heron's method adapted to integer arithmetic) finds the rounded-square-root of n:
-!
-! Let d be the number of digits of the number n.
-! If d is odd, set x_(0) = 2×10^((d-1)⁄2).
-! If d is even, set x_(0) = 7×10^((d-2)⁄2).
-! Repeat:
-!
-! until x_(k+1) = x_(k).
-!
+
+! We define the rounded-square-root of a positive integer n as the square root
+! of n rounded to the nearest integer.
+
+! The following procedure (essentially Heron's method adapted to integer
+! arithmetic) finds the rounded-square-root of n:
+
+! Let d be the number of digits of the number n.
+! If d is odd, set x_(0) = 2×10^((d-1)⁄2).
+! If d is even, set x_(0) = 7×10^((d-2)⁄2).
+
+! Repeat: [see URL for figure ]
+
+! until x_(k+1) = x_(k).
+
! As an example, let us find the rounded-square-root of n = 4321.
! n has 4 digits, so x_(0) = 7×10^((4-2)⁄2) = 70.
-!
+
+! [ see URL for figure ]
+
! Since x_(2) = x_(1), we stop here.
-! So, after just two iterations, we have found that the rounded-square-root of 4321 is 66 (the actual square root is 65.7343137…).
-!
+
+! So, after just two iterations, we have found that the rounded-square-root of
+! 4321 is 66 (the actual square root is 65.7343137…).
+
! The number of iterations required when using this method is surprisingly low.
-! For example, we can find the rounded-square-root of a 5-digit integer (10,000 ≤ n ≤ 99,999) with an average of 3.2102888889 iterations (the average value was rounded to 10 decimal places).
-!
-! Using the procedure described above, what is the average number of iterations required to find the rounded-square-root of a 14-digit number (10^(13) ≤ n < 10^(14))?
-! Give your answer rounded to 10 decimal places.
-!
-! Note: The symbols ⌊x⌋ and ⌈x⌉ represent the floor function and ceiling function respectively.
-!
-<PRIVATE
+! For example, we can find the rounded-square-root of a 5-digit integer
+! (10,000 ≤ n ≤ 99,999) with an average of 3.2102888889 iterations (the average
+! value was rounded to 10 decimal places).
+
+! Using the procedure described above, what is the average number of iterations
+! required to find the rounded-square-root of a 14-digit number
+! (10^(13) ≤ n < 10^(14))? Give your answer rounded to 10 decimal places.
+
+! Note: The symbols ⌊x⌋ and ⌈x⌉ represent the floor function and ceiling
+! function respectively.
-: round-to-10-decimals ( a -- b ) 1.0e10 * round 1.0e10 / ;
+! SOLUTION
+! --------
+
+<PRIVATE
! same as produce, but outputs the sum instead of the sequence of results
: produce-sum ( id pred quot -- sum )
[ 0 ] 2dip [ [ dip swap ] curry ] [ [ dip + ] curry ] bi* while ; inline
: x0 ( i -- x0 )
- number-length dup even?
+ number-length dup even?
[ 2 - 2 / 10 swap ^ 7 * ]
[ 1 - 2 / 10 swap ^ 2 * ] if ;
+
: ⌈a/b⌉ ( a b -- ⌈a/b⌉ )
[ 1 - + ] keep /i ;
DEFER: iteration#
! Gives the number of iterations when xk+1 has the same value for all a<=i<=n
:: (iteration#) ( i xi a b -- # )
- a xi xk+1 dup xi =
- [ drop i b a - 1 + * ]
- [ i 1 + swap a b iteration# ] if ;
+ a xi xk+1 dup xi =
+ [ drop i b a - 1 + * ]
+ [ i 1 + swap a b iteration# ] if ;
! Gives the number of iterations in the general case by breaking into intervals
! in which xk+1 is the same.
:: iteration# ( i xi a b -- # )
- a
- a xi next-multiple
- [ dup b < ]
- [
+ a
+ a xi next-multiple
+ [ dup b < ]
+ [
! set up the values for the next iteration
[ nip [ 1 + ] [ xi + ] bi ] 2keep
! set up the arguments for (iteration#)
- [ i xi ] 2dip (iteration#)
- ] produce-sum
+ [ i xi ] 2dip (iteration#)
+ ] produce-sum
! deal with the last numbers
[ drop b [ i xi ] 2dip (iteration#) ] dip
+ ;
-: 10^ ( a -- 10^a ) 10 swap ^ ; inline
-
-: (euler255) ( a b -- answer )
+: (euler255) ( a b -- answer )
[ 10^ ] bi@ 1 -
[ [ drop x0 1 swap ] 2keep iteration# ] 2keep
swap - 1 + /f ;
-
PRIVATE>
-: euler255 ( -- answer )
- 13 14 (euler255) round-to-10-decimals ;
+: euler255 ( -- answer )
+ 13 14 (euler255) 10 nth-place ;
-SOLUTION: euler255
+! [ euler255 ] gc time
+! Running time: 37.468911341 seconds
+SOLUTION: euler255
-! Copyright (c) 2007-2009 Aaron Schaefer.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel lists make math math.functions math.matrices
- math.primes.miller-rabin math.order math.parser math.primes.factors
- math.primes.lists math.ranges math.ratios namespaces parser prettyprint
- quotations sequences sorting strings unicode.case vocabs vocabs.parser
- words ;
+! Copyright (c) 2007-2010 Aaron Schaefer.
+! The contents of this file are licensed under the Simplified BSD License
+! A copy of the license is available at http://factorcode.org/license.txt
+USING: accessors arrays byte-arrays fry hints kernel lists make math
+ math.functions math.matrices math.order math.parser math.primes.factors
+ math.primes.lists math.primes.miller-rabin math.ranges math.ratios
+ namespaces parser prettyprint quotations sequences sorting strings
+ unicode.case vocabs vocabs.parser words ;
IN: project-euler.common
! A collection of words used by more than one Project Euler solution
! mediant - #71, #73
! nth-prime - #7, #69
! nth-triangle - #12, #42
-! number>digits - #16, #20, #30, #34, #35, #38, #43, #52, #55, #56, #92
+! number>digits - #16, #20, #30, #34, #35, #38, #43, #52, #55, #56, #92, #206
! palindrome? - #4, #36, #55
! pandigital? - #32, #38
! pentagonal? - #44, #45
! penultimate - #69, #71
! propagate-all - #18, #67
+! permutations? - #49, #70
! sum-proper-divisors - #21
! tau* - #12
! [uad]-transform - #39, #75
<PRIVATE
+: count-digits ( n -- byte-array )
+ 10 <byte-array> [
+ '[ 10 /mod _ [ 1 + ] change-nth dup 0 > ] loop drop
+ ] keep ;
+
+HINTS: count-digits fixnum ;
+
: max-children ( seq -- seq )
[ dup length 1 - iota [ nth-pair max , ] with each ] { } make ;
: alpha-value ( str -- n )
>lower [ CHAR: a - 1 + ] map-sum ;
-: cartesian-product ( seq1 seq2 -- seq1xseq2 )
- [ [ 2array ] with map ] curry map concat ;
-
: mediant ( a/c b/d -- (a+b)/(c+d) )
2>fraction [ + ] 2bi@ / ;
[ [ 10 * ] [ 1 + ] bi* ] while 2nip
] if-zero ;
+: nth-place ( x n -- y )
+ 10^ [ * round >integer ] keep /f ;
+
: nth-prime ( n -- n )
1 - lprimes lnth ;
reverse [ first dup ] [ rest ] bi
[ propagate dup ] map nip reverse swap suffix ;
+: permutations? ( n m -- ? )
+ [ count-digits ] bi@ = ;
+
: sum-divisors ( n -- sum )
dup 4 < [ { 0 1 3 4 } nth ] [ (sum-divisors) ] if ;
-! Copyright (c) 2007-2009 Aaron Schaefer, Samuel Tardieu.
+! Copyright (c) 2007-2010 Aaron Schaefer, Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
USING: definitions io io.files io.pathnames kernel math math.parser
prettyprint project-euler.ave-time sequences vocabs vocabs.loader
project-euler.037 project-euler.038 project-euler.039 project-euler.040
project-euler.041 project-euler.042 project-euler.043 project-euler.044
project-euler.045 project-euler.046 project-euler.047 project-euler.048
- project-euler.049 project-euler.051 project-euler.052 project-euler.053
- project-euler.054 project-euler.055 project-euler.056 project-euler.057
- project-euler.058 project-euler.059 project-euler.062 project-euler.063
- project-euler.065 project-euler.067 project-euler.069 project-euler.071
- project-euler.072 project-euler.073 project-euler.074 project-euler.075
- project-euler.076 project-euler.079 project-euler.081 project-euler.085
- project-euler.092 project-euler.097 project-euler.099 project-euler.100
- project-euler.102 project-euler.112 project-euler.116 project-euler.117
- project-euler.124 project-euler.134 project-euler.148 project-euler.150
- project-euler.151 project-euler.164 project-euler.169 project-euler.173
- project-euler.175 project-euler.186 project-euler.188 project-euler.190
- project-euler.203 project-euler.215 ;
+ project-euler.049 project-euler.050 project-euler.051 project-euler.052
+ project-euler.053 project-euler.054 project-euler.055 project-euler.056
+ project-euler.057 project-euler.058 project-euler.059 project-euler.062
+ project-euler.063 project-euler.065 project-euler.067 project-euler.069
+ project-euler.070 project-euler.071 project-euler.072 project-euler.073
+ project-euler.074 project-euler.075 project-euler.076 project-euler.079
+ project-euler.081 project-euler.085 project-euler.089 project-euler.092
+ project-euler.097 project-euler.099 project-euler.100 project-euler.102
+ project-euler.112 project-euler.116 project-euler.117 project-euler.124
+ project-euler.134 project-euler.148 project-euler.150 project-euler.151
+ project-euler.164 project-euler.169 project-euler.173 project-euler.175
+ project-euler.186 project-euler.188 project-euler.190 project-euler.203
+ project-euler.206 project-euler.215 project-euler.255 ;
IN: project-euler
<PRIVATE
-USING: classes.struct cocoa cocoa.application cocoa.classes
-cocoa.enumeration cocoa.plists core-foundation.strings kernel ;
+USING: alien.c-types classes.struct cocoa cocoa.application
+cocoa.classes cocoa.enumeration cocoa.plists core-foundation
+core-foundation.strings kernel ;
IN: qtkit
STRUCT: QTTime
+++ /dev/null
-unportable
+++ /dev/null
-USING: accessors assocs fry generalizations kernel locals math
-namespaces parser sequences shuffle words ;
-IN: set-n
-: get* ( var n -- val ) namestack dup length rot - head assoc-stack ;
-
-: set* ( val var n -- ) 1 + namestack [ length swap - ] keep nth set-at ;
-
-! dynamic lambda
-SYNTAX: :| (:) dup in>> dup length [ spin '[ _ narray _ swap zip _ bind ] ] 2curry dip define-declared ;
math
math.order
openal
+ openal.alut
opengl.gl
sequences
ui
HELP: run-spider
{ $values
- { "spider" spider }
{ "spider" spider } }
{ $description "Runs a spider until completion. See the " { $subsection "spider-tutorial" } " for a complete description of the tuple slots that affect how thet spider works." } ;
! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types combinators kernel locals math
+USING: accessors alien combinators kernel locals math
math.ranges openal sequences sequences.merged specialized-arrays ;
-FROM: alien.c-types => short ;
+FROM: alien.c-types => short uchar ;
SPECIALIZED-ARRAY: uchar
SPECIALIZED-ARRAY: short
IN: synth.buffers
! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel namespaces make openal sequences
+USING: accessors arrays kernel namespaces make openal openal.alut sequences
synth synth.buffers ;
IN: synth.example
! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel locals math math.constants math.functions memoize openal synth.buffers sequences sequences.modified sequences.repeating ;
+USING: accessors kernel locals math math.constants math.functions memoize openal openal.alut synth.buffers sequences sequences.modified sequences.repeating ;
IN: synth
MEMO: single-sine-wave ( samples/wave -- seq )
FUNCTION: TCADB* tcadbnew ( ) ;
FUNCTION: void tcadbdel ( TCADB* adb ) ;
-FUNCTION: bool tcadbopen ( TCADB* adb, char* name ) ;
+FUNCTION: bool tcadbopen ( TCADB* adb, c-string name ) ;
FUNCTION: bool tcadbclose ( TCADB* adb ) ;
FUNCTION: bool tcadbput ( TCADB* adb, void* kbuf, int ksiz, void* vbuf, int vsiz ) ;
-FUNCTION: bool tcadbput2 ( TCADB* adb, char* kstr, char* vstr ) ;
+FUNCTION: bool tcadbput2 ( TCADB* adb, c-string kstr, c-string vstr ) ;
FUNCTION: bool tcadbputkeep ( TCADB* adb, void* kbuf, int ksiz, void* vbuf, int vsiz ) ;
-FUNCTION: bool tcadbputkeep2 ( TCADB* adb, char* kstr, char* vstr ) ;
+FUNCTION: bool tcadbputkeep2 ( TCADB* adb, c-string kstr, c-string vstr ) ;
FUNCTION: bool tcadbputcat ( TCADB* adb, void* kbuf, int ksiz, void* vbuf, int vsiz ) ;
-FUNCTION: bool tcadbputcat2 ( TCADB* adb, char* kstr, char* vstr ) ;
+FUNCTION: bool tcadbputcat2 ( TCADB* adb, c-string kstr, c-string vstr ) ;
FUNCTION: bool tcadbout ( TCADB* adb, void* kbuf, int ksiz ) ;
-FUNCTION: bool tcadbout2 ( TCADB* adb, char* kstr ) ;
+FUNCTION: bool tcadbout2 ( TCADB* adb, c-string kstr ) ;
FUNCTION: void* tcadbget ( TCADB* adb, void* kbuf, int ksiz, int* sp ) ;
-FUNCTION: char* tcadbget2 ( TCADB* adb, char* kstr ) ;
+FUNCTION: c-string tcadbget2 ( TCADB* adb, c-string kstr ) ;
FUNCTION: int tcadbvsiz ( TCADB* adb, void* kbuf, int ksiz ) ;
-FUNCTION: int tcadbvsiz2 ( TCADB* adb, char* kstr ) ;
+FUNCTION: int tcadbvsiz2 ( TCADB* adb, c-string kstr ) ;
FUNCTION: bool tcadbiterinit ( TCADB* adb ) ;
FUNCTION: void* tcadbiternext ( TCADB* adb, int* sp ) ;
-FUNCTION: char* tcadbiternext2 ( TCADB* adb ) ;
+FUNCTION: c-string tcadbiternext2 ( TCADB* adb ) ;
FUNCTION: TCLIST* tcadbfwmkeys ( TCADB* adb, void* pbuf, int psiz, int max ) ;
-FUNCTION: TCLIST* tcadbfwmkeys2 ( TCADB* adb, char* pstr, int max ) ;
+FUNCTION: TCLIST* tcadbfwmkeys2 ( TCADB* adb, c-string pstr, int max ) ;
FUNCTION: int tcadbaddint ( TCADB* adb, void* kbuf, int ksiz, int num ) ;
FUNCTION: double tcadbadddouble ( TCADB* adb, void* kbuf, int ksiz, double num ) ;
FUNCTION: bool tcadbsync ( TCADB* adb ) ;
-FUNCTION: bool tcadboptimize ( TCADB* adb, char* params ) ;
+FUNCTION: bool tcadboptimize ( TCADB* adb, c-string params ) ;
FUNCTION: bool tcadbvanish ( TCADB* adb ) ;
-FUNCTION: bool tcadbcopy ( TCADB* adb, char* path ) ;
+FUNCTION: bool tcadbcopy ( TCADB* adb, c-string path ) ;
FUNCTION: bool tcadbtranbegin ( TCADB* adb ) ;
FUNCTION: bool tcadbtrancommit ( TCADB* adb ) ;
FUNCTION: bool tcadbtranabort ( TCADB* adb ) ;
-FUNCTION: char* tcadbpath ( TCADB* adb ) ;
+FUNCTION: c-string tcadbpath ( TCADB* adb ) ;
FUNCTION: ulonglong tcadbrnum ( TCADB* adb ) ;
FUNCTION: ulonglong tcadbsize ( TCADB* adb ) ;
-FUNCTION: TCLIST* tcadbmisc ( TCADB* adb, char* name, TCLIST* args ) ;
+FUNCTION: TCLIST* tcadbmisc ( TCADB* adb, c-string name, TCLIST* args ) ;
! -----
FUNCTION: bool tcadbputproc ( TCADB* adb, void* kbuf, int ksiz, void* vbuf, int vsiz, TCPDPROC proc, void* op ) ;
FUNCTION: bool tcadbforeach ( TCADB* adb, TCITER iter, void* op ) ;
FUNCTION: bool tcadbmapbdb ( TCADB* adb, TCLIST* keys, TCBDB* bdb, ADBMAPPROC proc, void* op, longlong csiz ) ;
-FUNCTION: bool tcadbmapbdbemit ( void* map, char* kbuf, int ksiz, char* vbuf, int vsiz ) ;
+FUNCTION: bool tcadbmapbdbemit ( void* map, c-string kbuf, int ksiz, c-string vbuf, int vsiz ) ;
BDBCPBEFORE
BDBCPAFTER ;
-FUNCTION: char* tcbdberrmsg ( int ecode ) ;
+FUNCTION: c-string tcbdberrmsg ( int ecode ) ;
FUNCTION: TCBDB* tcbdbnew ( ) ;
FUNCTION: void tcbdbdel ( TCBDB* bdb ) ;
FUNCTION: int tcbdbecode ( TCBDB* bdb ) ;
FUNCTION: bool tcbdbtune ( TCBDB* bdb, int lmemb, int nmemb, longlong bnum, char apow, char fpow, uchar opts ) ;
FUNCTION: bool tcbdbsetcache ( TCBDB* bdb, int lcnum, int ncnum ) ;
FUNCTION: bool tcbdbsetxmsiz ( TCBDB* bdb, longlong xmsiz ) ;
-FUNCTION: bool tcbdbopen ( TCBDB* bdb, char* path, int omode ) ;
+FUNCTION: bool tcbdbopen ( TCBDB* bdb, c-string path, int omode ) ;
FUNCTION: bool tcbdbclose ( TCBDB* bdb ) ;
FUNCTION: bool tcbdbput ( TCBDB* bdb, void* kbuf, int ksiz, void* vbuf, int vsiz ) ;
-FUNCTION: bool tcbdbput2 ( TCBDB* bdb, char* kstr, char* vstr ) ;
+FUNCTION: bool tcbdbput2 ( TCBDB* bdb, c-string kstr, c-string vstr ) ;
FUNCTION: bool tcbdbputkeep ( TCBDB* bdb, void* kbuf, int ksiz, void* vbuf, int vsiz ) ;
-FUNCTION: bool tcbdbputkeep2 ( TCBDB* bdb, char* kstr, char* vstr ) ;
+FUNCTION: bool tcbdbputkeep2 ( TCBDB* bdb, c-string kstr, c-string vstr ) ;
FUNCTION: bool tcbdbputcat ( TCBDB* bdb, void* kbuf, int ksiz, void* vbuf, int vsiz ) ;
-FUNCTION: bool tcbdbputcat2 ( TCBDB* bdb, char* kstr, char* vstr ) ;
+FUNCTION: bool tcbdbputcat2 ( TCBDB* bdb, c-string kstr, c-string vstr ) ;
FUNCTION: bool tcbdbputdup ( TCBDB* bdb, void* kbuf, int ksiz, void* vbuf, int vsiz ) ;
-FUNCTION: bool tcbdbputdup2 ( TCBDB* bdb, char* kstr, char* vstr ) ;
+FUNCTION: bool tcbdbputdup2 ( TCBDB* bdb, c-string kstr, c-string vstr ) ;
FUNCTION: bool tcbdbputdup3 ( TCBDB* bdb, void* kbuf, int ksiz, TCLIST* vals ) ;
FUNCTION: bool tcbdbout ( TCBDB* bdb, void* kbuf, int ksiz ) ;
-FUNCTION: bool tcbdbout2 ( TCBDB* bdb, char* kstr ) ;
+FUNCTION: bool tcbdbout2 ( TCBDB* bdb, c-string kstr ) ;
FUNCTION: bool tcbdbout3 ( TCBDB* bdb, void* kbuf, int ksiz ) ;
FUNCTION: void* tcbdbget ( TCBDB* bdb, void* kbuf, int ksiz, int* sp ) ;
-FUNCTION: char* tcbdbget2 ( TCBDB* bdb, char* kstr ) ;
+FUNCTION: c-string tcbdbget2 ( TCBDB* bdb, c-string kstr ) ;
FUNCTION: void* tcbdbget3 ( TCBDB* bdb, void* kbuf, int ksiz, int* sp ) ;
FUNCTION: TCLIST* tcbdbget4 ( TCBDB* bdb, void* kbuf, int ksiz ) ;
FUNCTION: int tcbdbvnum ( TCBDB* bdb, void* kbuf, int ksiz ) ;
-FUNCTION: int tcbdbvnum2 ( TCBDB* bdb, char* kstr ) ;
+FUNCTION: int tcbdbvnum2 ( TCBDB* bdb, c-string kstr ) ;
FUNCTION: int tcbdbvsiz ( TCBDB* bdb, void* kbuf, int ksiz ) ;
-FUNCTION: int tcbdbvsiz2 ( TCBDB* bdb, char* kstr ) ;
+FUNCTION: int tcbdbvsiz2 ( TCBDB* bdb, c-string kstr ) ;
FUNCTION: TCLIST* tcbdbrange ( TCBDB* bdb, void* bkbuf, int bksiz, bool binc, void* ekbuf, int eksiz, bool einc, int max ) ;
-FUNCTION: TCLIST* tcbdbrange2 ( TCBDB* bdb, char* bkstr, bool binc, char* ekstr, bool einc, int max ) ;
+FUNCTION: TCLIST* tcbdbrange2 ( TCBDB* bdb, c-string bkstr, bool binc, c-string ekstr, bool einc, int max ) ;
FUNCTION: TCLIST* tcbdbfwmkeys ( TCBDB* bdb, void* pbuf, int psiz, int max ) ;
-FUNCTION: TCLIST* tcbdbfwmkeys2 ( TCBDB* bdb, char* pstr, int max ) ;
+FUNCTION: TCLIST* tcbdbfwmkeys2 ( TCBDB* bdb, c-string pstr, int max ) ;
FUNCTION: int tcbdbaddint ( TCBDB* bdb, void* kbuf, int ksiz, int num ) ;
FUNCTION: double tcbdbadddouble ( TCBDB* bdb, void* kbuf, int ksiz, double num ) ;
FUNCTION: bool tcbdbsync ( TCBDB* bdb ) ;
FUNCTION: bool tcbdboptimize ( TCBDB* bdb, int lmemb, int nmemb, longlong bnum, char apow, char fpow, uchar opts ) ;
FUNCTION: bool tcbdbvanish ( TCBDB* bdb ) ;
-FUNCTION: bool tcbdbcopy ( TCBDB* bdb, char* path ) ;
+FUNCTION: bool tcbdbcopy ( TCBDB* bdb, c-string path ) ;
FUNCTION: bool tcbdbtranbegin ( TCBDB* bdb ) ;
FUNCTION: bool tcbdbtrancommit ( TCBDB* bdb ) ;
FUNCTION: bool tcbdbtranabort ( TCBDB* bdb ) ;
-FUNCTION: char* tcbdbpath ( TCBDB* bdb ) ;
+FUNCTION: c-string tcbdbpath ( TCBDB* bdb ) ;
FUNCTION: ulonglong tcbdbrnum ( TCBDB* bdb ) ;
FUNCTION: ulonglong tcbdbfsiz ( TCBDB* bdb ) ;
FUNCTION: BDBCUR* tcbdbcurnew ( TCBDB* bdb ) ;
FUNCTION: bool tcbdbcurfirst ( BDBCUR* cur ) ;
FUNCTION: bool tcbdbcurlast ( BDBCUR* cur ) ;
FUNCTION: bool tcbdbcurjump ( BDBCUR* cur, void* kbuf, int ksiz ) ;
-FUNCTION: bool tcbdbcurjump2 ( BDBCUR* cur, char* kstr ) ;
+FUNCTION: bool tcbdbcurjump2 ( BDBCUR* cur, c-string kstr ) ;
FUNCTION: bool tcbdbcurprev ( BDBCUR* cur ) ;
FUNCTION: bool tcbdbcurnext ( BDBCUR* cur ) ;
FUNCTION: bool tcbdbcurput ( BDBCUR* cur, void* vbuf, int vsiz, int cpmode ) ;
-FUNCTION: bool tcbdbcurput2 ( BDBCUR* cur, char* vstr, int cpmode ) ;
+FUNCTION: bool tcbdbcurput2 ( BDBCUR* cur, c-string vstr, int cpmode ) ;
FUNCTION: bool tcbdbcurout ( BDBCUR* cur ) ;
FUNCTION: void* tcbdbcurkey ( BDBCUR* cur, int* sp ) ;
-FUNCTION: char* tcbdbcurkey2 ( BDBCUR* cur ) ;
+FUNCTION: c-string tcbdbcurkey2 ( BDBCUR* cur ) ;
FUNCTION: void* tcbdbcurkey3 ( BDBCUR* cur, int* sp ) ;
FUNCTION: void* tcbdbcurval ( BDBCUR* cur, int* sp ) ;
-FUNCTION: char* tcbdbcurval2 ( BDBCUR* cur ) ;
+FUNCTION: c-string tcbdbcurval2 ( BDBCUR* cur ) ;
FUNCTION: void* tcbdbcurval3 ( BDBCUR* cur, int* sp ) ;
FUNCTION: bool tcbdbcurrec ( BDBCUR* cur, TCXSTR* kxstr, TCXSTR* vxstr ) ;
! -----------
-FUNCTION: void tcbdbsetecode ( TCBDB* bdb, int ecode, char* filename, int line, char* func ) ;
+FUNCTION: void tcbdbsetecode ( TCBDB* bdb, int ecode, c-string filename, int line, c-string func ) ;
FUNCTION: void tcbdbsetdbgfd ( TCBDB* bdb, int fd ) ;
FUNCTION: int tcbdbdbgfd ( TCBDB* bdb ) ;
FUNCTION: bool tcbdbhasmutex ( TCBDB* bdb ) ;
FUNCTION: tokyo_time_t tcbdbmtime ( TCBDB* bdb ) ;
FUNCTION: uchar tcbdbflags ( TCBDB* bdb ) ;
FUNCTION: uchar tcbdbopts ( TCBDB* bdb ) ;
-FUNCTION: char* tcbdbopaque ( TCBDB* bdb ) ;
+FUNCTION: c-string tcbdbopaque ( TCBDB* bdb ) ;
FUNCTION: ulonglong tcbdbbnumused ( TCBDB* bdb ) ;
FUNCTION: bool tcbdbsetlsmax ( TCBDB* bdb, uint lsmax ) ;
FUNCTION: bool tcbdbsetcapnum ( TCBDB* bdb, ulonglong capnum ) ;
FUNCTION: bool tcbdbsetcodecfunc ( TCBDB* bdb, TCCODEC enc, void* encop, TCCODEC dec, void* decop ) ;
FUNCTION: bool tcbdbputdupback ( TCBDB* bdb, void* kbuf, int ksiz, void* vbuf, int vsiz ) ;
-FUNCTION: bool tcbdbputdupback2 ( TCBDB* bdb, char* kstr, char* vstr ) ;
+FUNCTION: bool tcbdbputdupback2 ( TCBDB* bdb, c-string kstr, c-string vstr ) ;
FUNCTION: bool tcbdbputproc ( TCBDB* bdb, void* kbuf, int ksiz, void* vbuf, int vsiz, TCPDPROC proc, void* op ) ;
FUNCTION: bool tcbdbcurjumpback ( BDBCUR* cur, void* kbuf, int ksiz ) ;
-FUNCTION: bool tcbdbcurjumpback2 ( BDBCUR* cur, char* kstr ) ;
+FUNCTION: bool tcbdbcurjumpback2 ( BDBCUR* cur, c-string kstr ) ;
FUNCTION: bool tcbdbforeach ( TCBDB* bdb, TCITER iter, void* op ) ;
CONSTANT: FDBIDMAX -3
CONSTANT: FDBIDNEXT -4
-FUNCTION: char* tcfdberrmsg ( int ecode ) ;
+FUNCTION: c-string tcfdberrmsg ( int ecode ) ;
FUNCTION: TCFDB* tcfdbnew ( ) ;
FUNCTION: void tcfdbdel ( TCFDB* fdb ) ;
FUNCTION: int tcfdbecode ( TCFDB* fdb ) ;
FUNCTION: bool tcfdbsetmutex ( TCFDB* fdb ) ;
FUNCTION: bool tcfdbtune ( TCFDB* fdb, int width, longlong limsiz ) ;
-FUNCTION: bool tcfdbopen ( TCFDB* fdb, char* path, int omode ) ;
+FUNCTION: bool tcfdbopen ( TCFDB* fdb, c-string path, int omode ) ;
FUNCTION: bool tcfdbclose ( TCFDB* fdb ) ;
FUNCTION: bool tcfdbput ( TCFDB* fdb, longlong id, void* vbuf, int vsiz ) ;
FUNCTION: bool tcfdbput2 ( TCFDB* fdb, void* kbuf, int ksiz, void* vbuf, int vsiz ) ;
-FUNCTION: bool tcfdbput3 ( TCFDB* fdb, char* kstr, void* vstr ) ;
+FUNCTION: bool tcfdbput3 ( TCFDB* fdb, c-string kstr, void* vstr ) ;
FUNCTION: bool tcfdbputkeep ( TCFDB* fdb, longlong id, void* vbuf, int vsiz ) ;
FUNCTION: bool tcfdbputkeep2 ( TCFDB* fdb, void* kbuf, int ksiz, void* vbuf, int vsiz ) ;
-FUNCTION: bool tcfdbputkeep3 ( TCFDB* fdb, char* kstr, void* vstr ) ;
+FUNCTION: bool tcfdbputkeep3 ( TCFDB* fdb, c-string kstr, void* vstr ) ;
FUNCTION: bool tcfdbputcat ( TCFDB* fdb, longlong id, void* vbuf, int vsiz ) ;
FUNCTION: bool tcfdbputcat2 ( TCFDB* fdb, void* kbuf, int ksiz, void* vbuf, int vsiz ) ;
-FUNCTION: bool tcfdbputcat3 ( TCFDB* fdb, char* kstr, void* vstr ) ;
+FUNCTION: bool tcfdbputcat3 ( TCFDB* fdb, c-string kstr, void* vstr ) ;
FUNCTION: bool tcfdbout ( TCFDB* fdb, longlong id ) ;
FUNCTION: bool tcfdbout2 ( TCFDB* fdb, void* kbuf, int ksiz ) ;
-FUNCTION: bool tcfdbout3 ( TCFDB* fdb, char* kstr ) ;
+FUNCTION: bool tcfdbout3 ( TCFDB* fdb, c-string kstr ) ;
FUNCTION: void* tcfdbget ( TCFDB* fdb, longlong id, int* sp ) ;
FUNCTION: void* tcfdbget2 ( TCFDB* fdb, void* kbuf, int ksiz, int* sp ) ;
-FUNCTION: char* tcfdbget3 ( TCFDB* fdb, char* kstr ) ;
+FUNCTION: c-string tcfdbget3 ( TCFDB* fdb, c-string kstr ) ;
FUNCTION: int tcfdbget4 ( TCFDB* fdb, longlong id, void* vbuf, int max ) ;
FUNCTION: int tcfdbvsiz ( TCFDB* fdb, longlong id ) ;
FUNCTION: int tcfdbvsiz2 ( TCFDB* fdb, void* kbuf, int ksiz ) ;
-FUNCTION: int tcfdbvsiz3 ( TCFDB* fdb, char* kstr ) ;
+FUNCTION: int tcfdbvsiz3 ( TCFDB* fdb, c-string kstr ) ;
FUNCTION: bool tcfdbiterinit ( TCFDB* fdb ) ;
FUNCTION: ulonglong tcfdbiternext ( TCFDB* fdb ) ;
FUNCTION: void* tcfdbiternext2 ( TCFDB* fdb, int* sp ) ;
-FUNCTION: char* tcfdbiternext3 ( TCFDB* fdb ) ;
+FUNCTION: c-string tcfdbiternext3 ( TCFDB* fdb ) ;
FUNCTION: ulonglong* tcfdbrange ( TCFDB* fdb, longlong lower, longlong upper, int max, int* np ) ;
FUNCTION: TCLIST* tcfdbrange2 ( TCFDB* fdb, void* lbuf, int lsiz, void* ubuf, int usiz, int max ) ;
-FUNCTION: TCLIST* tcfdbrange3 ( TCFDB* fdb, char* lstr, char* ustr, int max ) ;
+FUNCTION: TCLIST* tcfdbrange3 ( TCFDB* fdb, c-string lstr, c-string ustr, int max ) ;
FUNCTION: TCLIST* tcfdbrange4 ( TCFDB* fdb, void* ibuf, int isiz, int max ) ;
FUNCTION: TCLIST* tcfdbrange5 ( TCFDB* fdb, void* istr, int max ) ;
FUNCTION: int tcfdbaddint ( TCFDB* fdb, longlong id, int num ) ;
FUNCTION: bool tcfdbsync ( TCFDB* fdb ) ;
FUNCTION: bool tcfdboptimize ( TCFDB* fdb, int width, longlong limsiz ) ;
FUNCTION: bool tcfdbvanish ( TCFDB* fdb ) ;
-FUNCTION: bool tcfdbcopy ( TCFDB* fdb, char* path ) ;
+FUNCTION: bool tcfdbcopy ( TCFDB* fdb, c-string path ) ;
FUNCTION: bool tcfdbtranbegin ( TCFDB* fdb ) ;
FUNCTION: bool tcfdbtrancommit ( TCFDB* fdb ) ;
FUNCTION: bool tcfdbtranabort ( TCFDB* fdb ) ;
-FUNCTION: char* tcfdbpath ( TCFDB* fdb ) ;
+FUNCTION: c-string tcfdbpath ( TCFDB* fdb ) ;
FUNCTION: ulonglong tcfdbrnum ( TCFDB* fdb ) ;
FUNCTION: ulonglong tcfdbfsiz ( TCFDB* fdb ) ;
! --------
-FUNCTION: void tcfdbsetecode ( TCFDB* fdb, int ecode, char* filename, int line, char* func ) ;
+FUNCTION: void tcfdbsetecode ( TCFDB* fdb, int ecode, c-string filename, int line, c-string func ) ;
FUNCTION: void tcfdbsetdbgfd ( TCFDB* fdb, int fd ) ;
FUNCTION: int tcfdbdbgfd ( TCFDB* fdb ) ;
FUNCTION: bool tcfdbhasmutex ( TCFDB* fdb ) ;
FUNCTION: int tcfdbomode ( TCFDB* fdb ) ;
FUNCTION: uchar tcfdbtype ( TCFDB* fdb ) ;
FUNCTION: uchar tcfdbflags ( TCFDB* fdb ) ;
-FUNCTION: char* tcfdbopaque ( TCFDB* fdb ) ;
+FUNCTION: c-string tcfdbopaque ( TCFDB* fdb ) ;
FUNCTION: bool tcfdbputproc ( TCFDB* fdb, longlong id, void* vbuf, int vsiz, TCPDPROC proc, void* op ) ;
FUNCTION: bool tcfdbforeach ( TCFDB* fdb, TCITER iter, void* op ) ;
-FUNCTION: longlong tcfdbkeytoid ( char* kbuf, int ksiz ) ;
+FUNCTION: longlong tcfdbkeytoid ( c-string kbuf, int ksiz ) ;
CONSTANT: HDBOLCKNB 32
CONSTANT: HDBOTSYNC 64
-FUNCTION: char* tchdberrmsg ( int ecode ) ;
+FUNCTION: c-string tchdberrmsg ( int ecode ) ;
FUNCTION: TCHDB* tchdbnew ( ) ;
FUNCTION: void tchdbdel ( TCHDB* hdb ) ;
FUNCTION: int tchdbecode ( TCHDB* hdb ) ;
FUNCTION: bool tchdbtune ( TCHDB* hdb, longlong bnum, char apow, char fpow, uchar opts ) ;
FUNCTION: bool tchdbsetcache ( TCHDB* hdb, int rcnum ) ;
FUNCTION: bool tchdbsetxmsiz ( TCHDB* hdb, longlong xmsiz ) ;
-FUNCTION: bool tchdbopen ( TCHDB* hdb, char* path, int omode ) ;
+FUNCTION: bool tchdbopen ( TCHDB* hdb, c-string path, int omode ) ;
FUNCTION: bool tchdbclose ( TCHDB* hdb ) ;
FUNCTION: bool tchdbput ( TCHDB* hdb, void* kbuf, int ksiz, void* vbuf, int vsiz ) ;
-FUNCTION: bool tchdbput2 ( TCHDB* hdb, char* kstr, char* vstr ) ;
+FUNCTION: bool tchdbput2 ( TCHDB* hdb, c-string kstr, c-string vstr ) ;
FUNCTION: bool tchdbputkeep ( TCHDB* hdb, void* kbuf, int ksiz, void* vbuf, int vsiz ) ;
-FUNCTION: bool tchdbputkeep2 ( TCHDB* hdb, char* kstr, char* vstr ) ;
+FUNCTION: bool tchdbputkeep2 ( TCHDB* hdb, c-string kstr, c-string vstr ) ;
FUNCTION: bool tchdbputcat ( TCHDB* hdb, void* kbuf, int ksiz, void* vbuf, int vsiz ) ;
-FUNCTION: bool tchdbputcat2 ( TCHDB* hdb, char* kstr, char* vstr ) ;
+FUNCTION: bool tchdbputcat2 ( TCHDB* hdb, c-string kstr, c-string vstr ) ;
FUNCTION: bool tchdbputasync ( TCHDB* hdb, void* kbuf, int ksiz, void* vbuf, int vsiz ) ;
-FUNCTION: bool tchdbputasync2 ( TCHDB* hdb, char* kstr, char* vstr ) ;
+FUNCTION: bool tchdbputasync2 ( TCHDB* hdb, c-string kstr, c-string vstr ) ;
FUNCTION: bool tchdbout ( TCHDB* hdb, void* kbuf, int ksiz ) ;
-FUNCTION: bool tchdbout2 ( TCHDB* hdb, char* kstr ) ;
+FUNCTION: bool tchdbout2 ( TCHDB* hdb, c-string kstr ) ;
FUNCTION: void* tchdbget ( TCHDB* hdb, void* kbuf, int ksiz, int* sp ) ;
-FUNCTION: char* tchdbget2 ( TCHDB* hdb, char* kstr ) ;
+FUNCTION: c-string tchdbget2 ( TCHDB* hdb, c-string kstr ) ;
FUNCTION: int tchdbget3 ( TCHDB* hdb, void* kbuf, int ksiz, void* vbuf, int max ) ;
FUNCTION: int tchdbvsiz ( TCHDB* hdb, void* kbuf, int ksiz ) ;
-FUNCTION: int tchdbvsiz2 ( TCHDB* hdb, char* kstr ) ;
+FUNCTION: int tchdbvsiz2 ( TCHDB* hdb, c-string kstr ) ;
FUNCTION: bool tchdbiterinit ( TCHDB* hdb ) ;
FUNCTION: void* tchdbiternext ( TCHDB* hdb, int* sp ) ;
-FUNCTION: char* tchdbiternext2 ( TCHDB* hdb ) ;
+FUNCTION: c-string tchdbiternext2 ( TCHDB* hdb ) ;
FUNCTION: bool tchdbiternext3 ( TCHDB* hdb, TCXSTR* kxstr, TCXSTR* vxstr ) ;
FUNCTION: TCLIST* tchdbfwmkeys ( TCHDB* hdb, void* pbuf, int psiz, int max ) ;
-FUNCTION: TCLIST* tchdbfwmkeys2 ( TCHDB* hdb, char* pstr, int max ) ;
+FUNCTION: TCLIST* tchdbfwmkeys2 ( TCHDB* hdb, c-string pstr, int max ) ;
FUNCTION: int tchdbaddint ( TCHDB* hdb, void* kbuf, int ksiz, int num ) ;
FUNCTION: double tchdbadddouble ( TCHDB* hdb, void* kbuf, int ksiz, double num ) ;
FUNCTION: bool tchdbsync ( TCHDB* hdb ) ;
FUNCTION: bool tchdboptimize ( TCHDB* hdb, longlong bnum, char apow, char fpow, uchar opts ) ;
FUNCTION: bool tchdbvanish ( TCHDB* hdb ) ;
-FUNCTION: bool tchdbcopy ( TCHDB* hdb, char* path ) ;
+FUNCTION: bool tchdbcopy ( TCHDB* hdb, c-string path ) ;
FUNCTION: bool tchdbtranbegin ( TCHDB* hdb ) ;
FUNCTION: bool tchdbtrancommit ( TCHDB* hdb ) ;
FUNCTION: bool tchdbtranabort ( TCHDB* hdb ) ;
-FUNCTION: char* tchdbpath ( TCHDB* hdb ) ;
+FUNCTION: c-string tchdbpath ( TCHDB* hdb ) ;
FUNCTION: ulonglong tchdbrnum ( TCHDB* hdb ) ;
FUNCTION: ulonglong tchdbfsiz ( TCHDB* hdb ) ;
! --------
-FUNCTION: void tchdbsetecode ( TCHDB* hdb, int ecode, char* filename, int line, char* func ) ;
+FUNCTION: void tchdbsetecode ( TCHDB* hdb, int ecode, c-string filename, int line, c-string func ) ;
FUNCTION: void tchdbsettype ( TCHDB* hdb, uchar type ) ;
FUNCTION: void tchdbsetdbgfd ( TCHDB* hdb, int fd ) ;
FUNCTION: int tchdbdbgfd ( TCHDB* hdb ) ;
FUNCTION: uchar tchdbtype ( TCHDB* hdb ) ;
FUNCTION: uchar tchdbflags ( TCHDB* hdb ) ;
FUNCTION: uchar tchdbopts ( TCHDB* hdb ) ;
-FUNCTION: char* tchdbopaque ( TCHDB* hdb ) ;
+FUNCTION: c-string tchdbopaque ( TCHDB* hdb ) ;
FUNCTION: ulonglong tchdbbnumused ( TCHDB* hdb ) ;
FUNCTION: bool tchdbsetcodecfunc ( TCHDB* hdb, TCCODEC enc, void* encop, TCCODEC dec, void* decop ) ;
FUNCTION: void tchdbcodecfunc ( TCHDB* hdb, TCCODEC* ep, void* *eop, TCCODEC* dp, void* *dop ) ;
FUNCTION: bool tchdbputproc ( TCHDB* hdb, void* kbuf, int ksiz, void* vbuf, int vsiz, TCPDPROC proc, void* op ) ;
FUNCTION: void* tchdbgetnext ( TCHDB* hdb, void* kbuf, int ksiz, int* sp ) ;
-FUNCTION: char* tchdbgetnext2 ( TCHDB* hdb, char* kstr ) ;
-FUNCTION: char* tchdbgetnext3 ( TCHDB* hdb, char* kbuf, int ksiz, int* sp, char* *vbp, int* vsp ) ;
+FUNCTION: c-string tchdbgetnext2 ( TCHDB* hdb, c-string kstr ) ;
+FUNCTION: c-string tchdbgetnext3 ( TCHDB* hdb, c-string kbuf, int ksiz, int* sp, c-string *vbp, int* vsp ) ;
FUNCTION: bool tchdbforeach ( TCHDB* hdb, TCITER iter, void* op ) ;
FUNCTION: bool tchdbtranvoid ( TCHDB* hdb ) ;
! STRUCT: TCRDB
! { mmtx pthread_mutex_t }
! { eckey pthread_key_t }
-! { host char* }
+! { host c-string }
! { port int }
-! { expr char* }
+! { expr c-string }
! { fd int }
! { sock TTSOCK* }
! { timeout double }
CONSTANT: RDBROCHKCON 1
CONSTANT: RDBMONOULOG 1
-FUNCTION: char* tcrdberrmsg ( int ecode ) ;
+FUNCTION: c-string tcrdberrmsg ( int ecode ) ;
FUNCTION: TCRDB* tcrdbnew ( ) ;
FUNCTION: void tcrdbdel ( TCRDB* rdb ) ;
FUNCTION: int tcrdbecode ( TCRDB* rdb ) ;
FUNCTION: bool tcrdbtune ( TCRDB* rdb, double timeout, int opts ) ;
-FUNCTION: bool tcrdbopen ( TCRDB* rdb, char* host, int port ) ;
-FUNCTION: bool tcrdbopen2 ( TCRDB* rdb, char* expr ) ;
+FUNCTION: bool tcrdbopen ( TCRDB* rdb, c-string host, int port ) ;
+FUNCTION: bool tcrdbopen2 ( TCRDB* rdb, c-string expr ) ;
FUNCTION: bool tcrdbclose ( TCRDB* rdb ) ;
FUNCTION: bool tcrdbput ( TCRDB* rdb, void* kbuf, int ksiz, void* vbuf, int vsiz ) ;
-FUNCTION: bool tcrdbput2 ( TCRDB* rdb, char* kstr, char* vstr ) ;
+FUNCTION: bool tcrdbput2 ( TCRDB* rdb, c-string kstr, c-string vstr ) ;
FUNCTION: bool tcrdbputkeep ( TCRDB* rdb, void* kbuf, int ksiz, void* vbuf, int vsiz ) ;
-FUNCTION: bool tcrdbputkeep2 ( TCRDB* rdb, char* kstr, char* vstr ) ;
+FUNCTION: bool tcrdbputkeep2 ( TCRDB* rdb, c-string kstr, c-string vstr ) ;
FUNCTION: bool tcrdbputcat ( TCRDB* rdb, void* kbuf, int ksiz, void* vbuf, int vsiz ) ;
-FUNCTION: bool tcrdbputcat2 ( TCRDB* rdb, char* kstr, char* vstr ) ;
+FUNCTION: bool tcrdbputcat2 ( TCRDB* rdb, c-string kstr, c-string vstr ) ;
FUNCTION: bool tcrdbputshl ( TCRDB* rdb, void* kbuf, int ksiz, void* vbuf, int vsiz, int width ) ;
-FUNCTION: bool tcrdbputshl2 ( TCRDB* rdb, char* kstr, char* vstr, int width ) ;
+FUNCTION: bool tcrdbputshl2 ( TCRDB* rdb, c-string kstr, c-string vstr, int width ) ;
FUNCTION: bool tcrdbputnr ( TCRDB* rdb, void* kbuf, int ksiz, void* vbuf, int vsiz ) ;
-FUNCTION: bool tcrdbputnr2 ( TCRDB* rdb, char* kstr, char* vstr ) ;
+FUNCTION: bool tcrdbputnr2 ( TCRDB* rdb, c-string kstr, c-string vstr ) ;
FUNCTION: bool tcrdbout ( TCRDB* rdb, void* kbuf, int ksiz ) ;
-FUNCTION: bool tcrdbout2 ( TCRDB* rdb, char* kstr ) ;
+FUNCTION: bool tcrdbout2 ( TCRDB* rdb, c-string kstr ) ;
FUNCTION: void* tcrdbget ( TCRDB* rdb, void* kbuf, int ksiz, int* sp ) ;
-FUNCTION: char* tcrdbget2 ( TCRDB* rdb, char* kstr ) ;
+FUNCTION: c-string tcrdbget2 ( TCRDB* rdb, c-string kstr ) ;
FUNCTION: bool tcrdbget3 ( TCRDB* rdb, TCMAP* recs ) ;
FUNCTION: int tcrdbvsiz ( TCRDB* rdb, void* kbuf, int ksiz ) ;
-FUNCTION: int tcrdbvsiz2 ( TCRDB* rdb, char* kstr ) ;
+FUNCTION: int tcrdbvsiz2 ( TCRDB* rdb, c-string kstr ) ;
FUNCTION: bool tcrdbiterinit ( TCRDB* rdb ) ;
FUNCTION: void* tcrdbiternext ( TCRDB* rdb, int* sp ) ;
-FUNCTION: char* tcrdbiternext2 ( TCRDB* rdb ) ;
+FUNCTION: c-string tcrdbiternext2 ( TCRDB* rdb ) ;
FUNCTION: TCLIST* tcrdbfwmkeys ( TCRDB* rdb, void* pbuf, int psiz, int max ) ;
-FUNCTION: TCLIST* tcrdbfwmkeys2 ( TCRDB* rdb, char* pstr, int max ) ;
+FUNCTION: TCLIST* tcrdbfwmkeys2 ( TCRDB* rdb, c-string pstr, int max ) ;
FUNCTION: int tcrdbaddint ( TCRDB* rdb, void* kbuf, int ksiz, int num ) ;
FUNCTION: double tcrdbadddouble ( TCRDB* rdb, void* kbuf, int ksiz, double num ) ;
-FUNCTION: void* tcrdbext ( TCRDB* rdb, char* name, int opts, void* kbuf, int ksiz, void* vbuf, int vsiz, int* sp ) ;
-FUNCTION: char* tcrdbext2 ( TCRDB* rdb, char* name, int opts, char* kstr, char* vstr ) ;
+FUNCTION: void* tcrdbext ( TCRDB* rdb, c-string name, int opts, void* kbuf, int ksiz, void* vbuf, int vsiz, int* sp ) ;
+FUNCTION: c-string tcrdbext2 ( TCRDB* rdb, c-string name, int opts, c-string kstr, c-string vstr ) ;
FUNCTION: bool tcrdbsync ( TCRDB* rdb ) ;
-FUNCTION: bool tcrdboptimize ( TCRDB* rdb, char* params ) ;
+FUNCTION: bool tcrdboptimize ( TCRDB* rdb, c-string params ) ;
FUNCTION: bool tcrdbvanish ( TCRDB* rdb ) ;
-FUNCTION: bool tcrdbcopy ( TCRDB* rdb, char* path ) ;
-FUNCTION: bool tcrdbrestore ( TCRDB* rdb, char* path, ulonglong ts, int opts ) ;
-FUNCTION: bool tcrdbsetmst ( TCRDB* rdb, char* host, int port, int opts ) ;
-FUNCTION: bool tcrdbsetmst2 ( TCRDB* rdb, char* expr, int opts ) ;
-FUNCTION: char* tcrdbexpr ( TCRDB* rdb ) ;
+FUNCTION: bool tcrdbcopy ( TCRDB* rdb, c-string path ) ;
+FUNCTION: bool tcrdbrestore ( TCRDB* rdb, c-string path, ulonglong ts, int opts ) ;
+FUNCTION: bool tcrdbsetmst ( TCRDB* rdb, c-string host, int port, int opts ) ;
+FUNCTION: bool tcrdbsetmst2 ( TCRDB* rdb, c-string expr, int opts ) ;
+FUNCTION: c-string tcrdbexpr ( TCRDB* rdb ) ;
FUNCTION: ulonglong tcrdbrnum ( TCRDB* rdb ) ;
FUNCTION: ulonglong tcrdbsize ( TCRDB* rdb ) ;
-FUNCTION: char* tcrdbstat ( TCRDB* rdb ) ;
-FUNCTION: TCLIST* tcrdbmisc ( TCRDB* rdb, char* name, int opts, TCLIST* args ) ;
+FUNCTION: c-string tcrdbstat ( TCRDB* rdb ) ;
+FUNCTION: TCLIST* tcrdbmisc ( TCRDB* rdb, c-string name, int opts, TCLIST* args ) ;
CONSTANT: RDBITLEXICAL TDBITLEXICAL
CONSTANT: RDBITDECIMAL TDBITDECIMAL
FUNCTION: bool tcrdbtblputcat ( TCRDB* rdb, void* pkbuf, int pksiz, TCMAP* cols ) ;
FUNCTION: bool tcrdbtblout ( TCRDB* rdb, void* pkbuf, int pksiz ) ;
FUNCTION: TCMAP* tcrdbtblget ( TCRDB* rdb, void* pkbuf, int pksiz ) ;
-FUNCTION: bool tcrdbtblsetindex ( TCRDB* rdb, char* name, int type ) ;
+FUNCTION: bool tcrdbtblsetindex ( TCRDB* rdb, c-string name, int type ) ;
FUNCTION: longlong tcrdbtblgenuid ( TCRDB* rdb ) ;
FUNCTION: RDBQRY* tcrdbqrynew ( TCRDB* rdb ) ;
FUNCTION: void tcrdbqrydel ( RDBQRY* qry ) ;
-FUNCTION: void tcrdbqryaddcond ( RDBQRY* qry, char* name, int op, char* expr ) ;
-FUNCTION: void tcrdbqrysetorder ( RDBQRY* qry, char* name, int type ) ;
+FUNCTION: void tcrdbqryaddcond ( RDBQRY* qry, c-string name, int op, c-string expr ) ;
+FUNCTION: void tcrdbqrysetorder ( RDBQRY* qry, c-string name, int type ) ;
FUNCTION: void tcrdbqrysetlimit ( RDBQRY* qry, int max, int skip ) ;
FUNCTION: TCLIST* tcrdbqrysearch ( RDBQRY* qry ) ;
FUNCTION: bool tcrdbqrysearchout ( RDBQRY* qry ) ;
! int (*)(const void *pkbuf, int pksiz, TCMAP *cols, void *op);
TYPEDEF: void* TDBQRYPROC
-FUNCTION: char* tctdberrmsg ( int ecode ) ;
+FUNCTION: c-string tctdberrmsg ( int ecode ) ;
FUNCTION: TCTDB* tctdbnew ( ) ;
FUNCTION: void tctdbdel ( TCTDB* tdb ) ;
FUNCTION: int tctdbecode ( TCTDB* tdb ) ;
FUNCTION: bool tctdbtune ( TCTDB* tdb, longlong bnum, char apow, char fpow, uchar opts ) ;
FUNCTION: bool tctdbsetcache ( TCTDB* tdb, int rcnum, int lcnum, int ncnum ) ;
FUNCTION: bool tctdbsetxmsiz ( TCTDB* tdb, longlong xmsiz ) ;
-FUNCTION: bool tctdbopen ( TCTDB* tdb, char* path, int omode ) ;
+FUNCTION: bool tctdbopen ( TCTDB* tdb, c-string path, int omode ) ;
FUNCTION: bool tctdbclose ( TCTDB* tdb ) ;
FUNCTION: bool tctdbput ( TCTDB* tdb, void* pkbuf, int pksiz, TCMAP* cols ) ;
FUNCTION: bool tctdbput2 ( TCTDB* tdb, void* pkbuf, int pksiz, void* cbuf, int csiz ) ;
-FUNCTION: bool tctdbput3 ( TCTDB* tdb, char* pkstr, char* cstr ) ;
+FUNCTION: bool tctdbput3 ( TCTDB* tdb, c-string pkstr, c-string cstr ) ;
FUNCTION: bool tctdbputkeep ( TCTDB* tdb, void* pkbuf, int pksiz, TCMAP* cols ) ;
FUNCTION: bool tctdbputkeep2 ( TCTDB* tdb, void* pkbuf, int pksiz, void* cbuf, int csiz ) ;
-FUNCTION: bool tctdbputkeep3 ( TCTDB* tdb, char* pkstr, char* cstr ) ;
+FUNCTION: bool tctdbputkeep3 ( TCTDB* tdb, c-string pkstr, c-string cstr ) ;
FUNCTION: bool tctdbputcat ( TCTDB* tdb, void* pkbuf, int pksiz, TCMAP* cols ) ;
FUNCTION: bool tctdbputcat2 ( TCTDB* tdb, void* pkbuf, int pksiz, void* cbuf, int csiz ) ;
-FUNCTION: bool tctdbputcat3 ( TCTDB* tdb, char* pkstr, char* cstr ) ;
+FUNCTION: bool tctdbputcat3 ( TCTDB* tdb, c-string pkstr, c-string cstr ) ;
FUNCTION: bool tctdbout ( TCTDB* tdb, void* pkbuf, int pksiz ) ;
-FUNCTION: bool tctdbout2 ( TCTDB* tdb, char* pkstr ) ;
+FUNCTION: bool tctdbout2 ( TCTDB* tdb, c-string pkstr ) ;
FUNCTION: TCMAP* tctdbget ( TCTDB* tdb, void* pkbuf, int pksiz ) ;
-FUNCTION: char* tctdbget2 ( TCTDB* tdb, void* pkbuf, int pksiz, int* sp ) ;
-FUNCTION: char* tctdbget3 ( TCTDB* tdb, char* pkstr ) ;
+FUNCTION: c-string tctdbget2 ( TCTDB* tdb, void* pkbuf, int pksiz, int* sp ) ;
+FUNCTION: c-string tctdbget3 ( TCTDB* tdb, c-string pkstr ) ;
FUNCTION: int tctdbvsiz ( TCTDB* tdb, void* pkbuf, int pksiz ) ;
-FUNCTION: int tctdbvsiz2 ( TCTDB* tdb, char* pkstr ) ;
+FUNCTION: int tctdbvsiz2 ( TCTDB* tdb, c-string pkstr ) ;
FUNCTION: bool tctdbiterinit ( TCTDB* tdb ) ;
FUNCTION: void* tctdbiternext ( TCTDB* tdb, int* sp ) ;
-FUNCTION: char* tctdbiternext2 ( TCTDB* tdb ) ;
+FUNCTION: c-string tctdbiternext2 ( TCTDB* tdb ) ;
FUNCTION: TCLIST* tctdbfwmkeys ( TCTDB* tdb, void* pbuf, int psiz, int max ) ;
-FUNCTION: TCLIST* tctdbfwmkeys2 ( TCTDB* tdb, char* pstr, int max ) ;
+FUNCTION: TCLIST* tctdbfwmkeys2 ( TCTDB* tdb, c-string pstr, int max ) ;
FUNCTION: int tctdbaddint ( TCTDB* tdb, void* pkbuf, int pksiz, int num ) ;
FUNCTION: double tctdbadddouble ( TCTDB* tdb, void* pkbuf, int pksiz, double num ) ;
FUNCTION: bool tctdbsync ( TCTDB* tdb ) ;
FUNCTION: bool tctdboptimize ( TCTDB* tdb, longlong bnum, char apow, char fpow, uchar opts ) ;
FUNCTION: bool tctdbvanish ( TCTDB* tdb ) ;
-FUNCTION: bool tctdbcopy ( TCTDB* tdb, char* path ) ;
+FUNCTION: bool tctdbcopy ( TCTDB* tdb, c-string path ) ;
FUNCTION: bool tctdbtranbegin ( TCTDB* tdb ) ;
FUNCTION: bool tctdbtrancommit ( TCTDB* tdb ) ;
FUNCTION: bool tctdbtranabort ( TCTDB* tdb ) ;
-FUNCTION: char* tctdbpath ( TCTDB* tdb ) ;
+FUNCTION: c-string tctdbpath ( TCTDB* tdb ) ;
FUNCTION: ulonglong tctdbrnum ( TCTDB* tdb ) ;
FUNCTION: ulonglong tctdbfsiz ( TCTDB* tdb ) ;
-FUNCTION: bool tctdbsetindex ( TCTDB* tdb, char* name, int type ) ;
+FUNCTION: bool tctdbsetindex ( TCTDB* tdb, c-string name, int type ) ;
FUNCTION: longlong tctdbgenuid ( TCTDB* tdb ) ;
FUNCTION: TDBQRY* tctdbqrynew ( TCTDB* tdb ) ;
FUNCTION: void tctdbqrydel ( TDBQRY* qry ) ;
-FUNCTION: void tctdbqryaddcond ( TDBQRY* qry, char* name, int op, char* expr ) ;
-FUNCTION: void tctdbqrysetorder ( TDBQRY* qry, char* name, int type ) ;
+FUNCTION: void tctdbqryaddcond ( TDBQRY* qry, c-string name, int op, c-string expr ) ;
+FUNCTION: void tctdbqrysetorder ( TDBQRY* qry, c-string name, int type ) ;
FUNCTION: void tctdbqrysetlimit ( TDBQRY* qry, int max, int skip ) ;
FUNCTION: TCLIST* tctdbqrysearch ( TDBQRY* qry ) ;
FUNCTION: bool tctdbqrysearchout ( TDBQRY* qry ) ;
FUNCTION: bool tctdbqryproc ( TDBQRY* qry, TDBQRYPROC proc, void* op ) ;
-FUNCTION: char* tctdbqryhint ( TDBQRY* qry ) ;
+FUNCTION: c-string tctdbqryhint ( TDBQRY* qry ) ;
! =======
-FUNCTION: void tctdbsetecode ( TCTDB* tdb, int ecode, char* filename, int line, char* func ) ;
+FUNCTION: void tctdbsetecode ( TCTDB* tdb, int ecode, c-string filename, int line, c-string func ) ;
FUNCTION: void tctdbsetdbgfd ( TCTDB* tdb, int fd ) ;
FUNCTION: int tctdbdbgfd ( TCTDB* tdb ) ;
FUNCTION: bool tctdbhasmutex ( TCTDB* tdb ) ;
FUNCTION: tokyo_time_t tctdbmtime ( TCTDB* tdb ) ;
FUNCTION: uchar tctdbflags ( TCTDB* tdb ) ;
FUNCTION: uchar tctdbopts ( TCTDB* tdb ) ;
-FUNCTION: char* tctdbopaque ( TCTDB* tdb ) ;
+FUNCTION: c-string tctdbopaque ( TCTDB* tdb ) ;
FUNCTION: ulonglong tctdbbnumused ( TCTDB* tdb ) ;
FUNCTION: int tctdbinum ( TCTDB* tdb ) ;
FUNCTION: longlong tctdbuidseed ( TCTDB* tdb ) ;
FUNCTION: bool tctdbforeach ( TCTDB* tdb, TCITER iter, void* op ) ;
FUNCTION: bool tctdbqryproc2 ( TDBQRY* qry, TDBQRYPROC proc, void* op ) ;
FUNCTION: bool tctdbqrysearchout2 ( TDBQRY* qry ) ;
-FUNCTION: int tctdbstrtoindextype ( char* str ) ;
+FUNCTION: int tctdbstrtoindextype ( c-string str ) ;
FUNCTION: int tctdbqrycount ( TDBQRY* qry ) ;
-FUNCTION: int tctdbqrystrtocondop ( char* str ) ;
-FUNCTION: int tctdbqrystrtoordertype ( char* str ) ;
+FUNCTION: int tctdbqrystrtocondop ( c-string str ) ;
+FUNCTION: int tctdbqrystrtoordertype ( c-string str ) ;
FUNCTION: void tclistdel ( TCLIST* list ) ;
FUNCTION: int tclistnum ( TCLIST* list ) ;
FUNCTION: void* tclistval ( TCLIST* list, int index, int* sp ) ;
-FUNCTION: char* tclistval2 ( TCLIST* list, int index ) ;
+FUNCTION: c-string tclistval2 ( TCLIST* list, int index ) ;
FUNCTION: void tclistpush ( TCLIST* list, void* ptr, int size ) ;
-FUNCTION: void tclistpush2 ( TCLIST* list, char* str ) ;
+FUNCTION: void tclistpush2 ( TCLIST* list, c-string str ) ;
FUNCTION: void tcfree ( void* ptr ) ;
TYPEDEF: void* TCCMP
tools
applications
demos
-networking
+network
<div class="contents">
<t:bind t:name="contents">
<h2>
- <t:a t:href="$wiki/view" t:query="title">
+ <t:a t:href="$wiki/view" t:rest="title">
<t:label t:name="title" />
</t:a>
</h2>
+++ /dev/null
-unportable
<login-config> <factor-boilerplate> test-db <alloy> "concatenative.org" add-responder
<pastebin> <login-config> <factor-boilerplate> test-db <alloy> "paste.factorcode.org" add-responder
<planet> <login-config> <factor-boilerplate> test-db <alloy> "planet.factorcode.org" add-responder
- <mason-app> <login-config> "builds.factorcode.org" add-responder
+ <mason-app> <login-config> test-db <alloy> "builds.factorcode.org" add-responder
home "docs" append-path <help-webapp> "docs.factorcode.org" add-responder
home "cgi" append-path <gitweb> "gitweb.factorcode.org" add-responder
main-responder set-global ;
(defsubst factor-mode--in-tests (&optional file)
(factor-mode--code-file "tests"))
-(defun factor-mode-visit-other-file (&optional skip)
+(defun factor-mode-visit-other-file (&optional create)
"Cycle between code, tests and docs factor files.
-With prefix, non-existing files will be skipped."
+With prefix, non-existing files will be created."
(interactive "P")
- (let ((file (factor-mode--cycle-next (buffer-file-name) skip)))
+ (let ((file (factor-mode--cycle-next (buffer-file-name) (not create))))
(unless file (error "No other file found"))
(find-file file)
(unless (file-exists-p file)
(comint-send-string nil "\"Refreshing loaded vocabs...\" write nl flush")
(comint-send-string nil " refresh-all \"Done!\" write nl flush\n")))
-(defun fuel-test-vocab (vocab)
- "Run the unit tests for the specified vocabulary."
- (interactive (list (fuel-completion--read-vocab nil (fuel-syntax--current-vocab))))
- (comint-send-string (fuel-listener--process)
- (concat "\"" vocab "\" reload nl flush\n"
- "\"" vocab "\" test nl flush\n")))
+(defun fuel-test-vocab (&optional arg)
+ "Run the unit tests for the current vocabulary. With prefix argument, ask for
+the vocabulary name."
+ (interactive "P")
+ (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
+ (fuel-completion--read-vocab nil))))
+ (comint-send-string (fuel-listener--process)
+ (concat "\"" vocab "\" reload nl flush\n"
+ "\"" vocab "\" test nl flush\n"))))
\f
;;; Completion support
"fuel")))
(fuel-eval--send/wait cmd)))
+(defsubst fuel-scaffold--create-tests (vocab)
+ (let ((cmd `(:fuel* (,vocab ,fuel-scaffold-developer-name fuel-scaffold-tests)
+ "fuel")))
+ (fuel-eval--send/wait cmd)))
+
+(defsubst fuel-scaffold--create-authors (vocab)
+ (let ((cmd `(:fuel* (,vocab ,fuel-scaffold-developer-name fuel-scaffold-authors) "fuel")))
+ (fuel-eval--send/wait cmd)))
+
+(defsubst fuel-scaffold--create-tags (vocab tags)
+ (let ((cmd `(:fuel* (,vocab ,tags fuel-scaffold-tags) "fuel")))
+ (fuel-eval--send/wait cmd)))
+
+(defsubst fuel-scaffold--create-summary (vocab summary)
+ (let ((cmd `(:fuel* (,vocab ,summary fuel-scaffold-summary) "fuel")))
+ (fuel-eval--send/wait cmd)))
+
+(defsubst fuel-scaffold--create-platforms (vocab platforms)
+ (let ((cmd `(:fuel* (,vocab ,platforms fuel-scaffold-platforms) "fuel")))
+ (fuel-eval--send/wait cmd)))
+
(defun fuel-scaffold--help (parent)
(when (and parent (fuel-scaffold--check-auto fuel-scaffold-help-autoinsert-p))
(let* ((ret (fuel-scaffold--create-docs (fuel-scaffold--vocab parent)))
(defun fuel-scaffold-vocab (&optional other-window name-hint root-hint)
"Creates a directory in the given root for a new vocabulary and
-adds source, tests and authors.txt files.
+adds source and authors.txt files. Prompts the user for optional summary,
+tags, help, and test file creation.
You can configure `fuel-scaffold-developer-name' (set by default to
`user-full-name') for the name to be inserted in the generated files."
(root (completing-read "Vocab root: "
(fuel-scaffold--vocab-roots)
nil t (or root-hint "resource:")))
+ (summary (read-string "Vocab summary (empty for none): "))
+ (tags (read-string "Vocab tags (empty for none): "))
+ (platforms (read-string "Vocab platforms (empty for all): "))
+ (help (y-or-n-p "Scaffold help? "))
+ (tests (y-or-n-p "Scaffold tests? "))
(cmd `(:fuel* ((,root ,name ,fuel-scaffold-developer-name)
(fuel-scaffold-vocab)) "fuel"))
(ret (fuel-eval--send/wait cmd))
(file (fuel-eval--retort-result ret)))
(unless file
(error "Error creating vocab (%s)" (car (fuel-eval--retort-error ret))))
+ (when (not (equal "" summary))
+ (fuel-scaffold--create-summary name summary))
+ (when (not (equal "" tags))
+ (fuel-scaffold--create-tags name tags))
+ (when (not (equal "" platforms))
+ (fuel-scaffold--create-platforms name platforms))
+ (when help
+ (fuel-scaffold--create-docs name))
+ (when tests
+ (fuel-scaffold--create-tests name))
(if other-window (find-file-other-window file) (find-file file))
(goto-char (point-max))
name))
(error "Error creating help file" (car (fuel-eval--retort-error ret))))
(find-file file)))
+(defun fuel-scaffold-tests (&optional arg)
+ "Creates, if it does not already exist, a tests file for the current vocabulary.
+
+With prefix argument, ask for the vocabulary name.
+You can configure `fuel-scaffold-developer-name' (set by default to
+`user-full-name') for the name to be inserted in the generated file."
+ (interactive "P")
+ (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
+ (fuel-completion--read-vocab nil)))
+ (ret (fuel-scaffold--create-tests vocab))
+ (file (fuel-eval--retort-result ret)))
+ (unless file
+ (error "Error creating tests file" (car (fuel-eval--retort-error ret))))
+ (find-file file)))
+
+(defun fuel-scaffold-authors (&optional arg)
+ "Creates, if it does not already exist, an authors file for the current vocabulary.
+
+With prefix argument, ask for the vocabulary name.
+You can configure `fuel-scaffold-developer-name' (set by default to
+`user-full-name') for the name to be inserted in the generated file."
+ (interactive "P")
+ (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
+ (fuel-completion--read-vocab nil)))
+ (ret (fuel-scaffold--create-authors vocab))
+ (file (fuel-eval--retort-result ret)))
+ (unless file
+ (error "Error creating authors file" (car (fuel-eval--retort-error ret))))
+ (find-file file)))
+
+(defun fuel-scaffold-tags (&optional arg)
+ "Creates, if it does not already exist, a tags file for the current vocabulary."
+ (interactive "P")
+ (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
+ (fuel-completion--read-vocab nil)))
+ (tags (read-string "Tags: "))
+ (ret (fuel-scaffold--create-tags vocab tags))
+ (file (fuel-eval--retort-result ret)))
+ (unless file
+ (error "Error creating tags file" (car (fuel-eval--retort-error ret))))
+ (find-file file)))
+
+(defun fuel-scaffold-summary (&optional arg)
+ "Creates, if it does not already exist, a summary file for the current vocabulary."
+ (interactive "P")
+ (let* ((vocab (or (and (not arg ) (fuel-syntax--current-vocab))
+ (fuel-completion--read-vocab nil)))
+ (summary (read-string "Summary: "))
+ (ret (fuel-scaffold--create-summary vocab summary))
+ (file (fuel-eval--retort-result ret)))
+ (unless file
+ (error "Error creating summary file" (car (fuel-eval--retort-error ret))))
+ (find-file file)))
+
+(defun fuel-scaffold-platforms (&optional arg)
+ "Creates, if it does not already exist, a platforms file for the current vocabulary."
+ (interactive "P")
+ (let* ((vocab (or (and (not arg ) (fuel-syntax--current-vocab))
+ (fuel-completion--read-vocab nil)))
+ (platforms (read-string "Platforms: "))
+ (ret (fuel-scaffold--create-platforms vocab platforms))
+ (file (fuel-eval--retort-result ret)))
+ (unless file
+ (error "Error creating platforms file" (car (fuel-eval--retort-error ret))))
+ (find-file file)))
+
\f
(provide 'fuel-scaffold)
;;; fuel-scaffold.el ends here
-;;; fuel-syntax.el --- auxiliar definitions for factor code navigation.
-
-;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
-;; See http://factorcode.org/license.txt for BSD license.
-
-;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
-;; Keywords: languages
-
-;;; Commentary:
-
-;; Auxiliar constants and functions to parse factor code.
-
-;;; Code:
-
-(require 'thingatpt)
-
-\f
-;;; Thing-at-point support for factor symbols:
-
-(defun fuel-syntax--beginning-of-symbol ()
- "Move point to the beginning of the current symbol."
- (skip-syntax-backward "w_()"))
-
-(defsubst fuel-syntax--beginning-of-symbol-pos ()
- (save-excursion (fuel-syntax--beginning-of-symbol) (point)))
-
-(defun fuel-syntax--end-of-symbol ()
- "Move point to the end of the current symbol."
- (skip-syntax-forward "w_()"))
-
-(defsubst fuel-syntax--end-of-symbol-pos ()
- (save-excursion (fuel-syntax--end-of-symbol) (point)))
-
-(put 'factor-symbol 'end-op 'fuel-syntax--end-of-symbol)
-(put 'factor-symbol 'beginning-op 'fuel-syntax--beginning-of-symbol)
-
-(defsubst fuel-syntax-symbol-at-point ()
- (let ((s (substring-no-properties (thing-at-point 'factor-symbol))))
- (and (> (length s) 0) s)))
-
-
-\f
-;;; Regexps galore:
-
-(defconst fuel-syntax--parsing-words
- '(":" "::" ";" "&:" "<<" "<PRIVATE" ">>"
- "ABOUT:" "ALIAS:" "ALIEN:" "ARTICLE:"
- "B" "BIN:"
- "C:" "CALLBACK:" "C-ENUM:" "C-STRUCT:" "C-TYPE:" "C-UNION:" "CHAR:" "CONSTANT:" "call-next-method"
- "DEFER:"
- "EBNF:" ";EBNF" "ERROR:" "EXCLUDE:"
- "f" "FORGET:" "FROM:" "FUNCTION:"
- "GAME:" "GENERIC#" "GENERIC:"
- "GLSL-SHADER:" "GLSL-PROGRAM:"
- "HELP:" "HEX:" "HOOK:"
- "IN:" "initial:" "INSTANCE:" "INTERSECTION:"
- "LIBRARY:"
- "M:" "M::" "MACRO:" "MACRO::" "MAIN:" "MATH:"
- "MEMO:" "MEMO:" "METHOD:" "MIXIN:"
- "OCT:"
- "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:"
- "QUALIFIED-WITH:" "QUALIFIED:"
- "read-only" "RENAME:" "REQUIRE:" "REQUIRES:"
- "SINGLETON:" "SINGLETONS:" "SLOT:" "SPECIALIZED-ARRAY:" "SPECIALIZED-ARRAYS:" "STRING:" "STRUCT:" "SYMBOL:" "SYMBOLS:" "SYNTAX:"
- "TUPLE:" "t" "t?" "TYPEDEF:" "TYPED:" "TYPED::"
- "UNIFORM-TUPLE:" "UNION:" "USE:" "USING:"
- "VARS:" "VERTEX-FORMAT:"))
-
-(defconst fuel-syntax--parsing-words-regex
- (regexp-opt fuel-syntax--parsing-words 'words))
-
-(defconst fuel-syntax--bracers
- '("B" "BV" "C" "CS" "H" "T" "V" "W"))
-
-(defconst fuel-syntax--brace-words-regex
- (format "%s{" (regexp-opt fuel-syntax--bracers t)))
-
-(defconst fuel-syntax--declaration-words
- '("flushable" "foldable" "inline" "parsing" "recursive" "delimiter"))
-
-(defconst fuel-syntax--declaration-words-regex
- (regexp-opt fuel-syntax--declaration-words 'words))
-
-(defsubst fuel-syntax--second-word-regex (prefixes)
- (format "%s +\\([^ \r\n]+\\)" (regexp-opt prefixes t)))
-
-(defconst fuel-syntax--method-definition-regex
- "^M::? +\\([^ ]+\\) +\\([^ ]+\\)")
-
-(defconst fuel-syntax--integer-regex
- "\\_<-?[0-9]+\\_>")
-
-(defconst fuel-syntax--raw-float-regex
- "[0-9]*\\.[0-9]*\\([eE][+-]?[0-9]+\\)?")
-
-(defconst fuel-syntax--float-regex
- (format "\\_<-?%s\\_>" fuel-syntax--raw-float-regex))
-
-(defconst fuel-syntax--number-regex
- (format "\\([0-9]+\\|%s\\)" fuel-syntax--raw-float-regex))
-
-(defconst fuel-syntax--ratio-regex
- (format "\\_<[+-]?%s/-?%s\\_>"
- fuel-syntax--number-regex
- fuel-syntax--number-regex))
-
-(defconst fuel-syntax--bad-string-regex
- "\\_<\"[^>]\\([^\"\n]\\|\\\\\"\\)*\n")
-
-(defconst fuel-syntax--word-definition-regex
- (format "\\_<\\(%s\\)?: +\\_<\\(\\w+\\)\\_>"
- (regexp-opt
- '(":" "GENERIC" "DEFER" "HOOK" "MAIN" "MATH" "POSTPONE"
- "SYMBOL" "SYNTAX" "TYPED" "RENAME"))))
-
-(defconst fuel-syntax--alias-definition-regex
- "^ALIAS: +\\(\\_<.+?\\_>\\) +\\(\\_<.+?\\_>\\)")
-
-(defconst fuel-syntax--vocab-ref-regexp
- (fuel-syntax--second-word-regex
- '("IN:" "USE:" "FROM:" "EXCLUDE:" "QUALIFIED:" "QUALIFIED-WITH:")))
-
-(defconst fuel-syntax--int-constant-def-regex
- (fuel-syntax--second-word-regex '("ALIEN:" "CHAR:" "BIN:" "HEX:" "OCT:")))
-
-(defconst fuel-syntax--type-definition-regex
- (fuel-syntax--second-word-regex
- '("C-STRUCT:" "C-UNION:" "MIXIN:" "TUPLE:" "SINGLETON:" "SPECIALIZED-ARRAY:" "STRUCT:" "UNION:")))
-
-(defconst fuel-syntax--tuple-decl-regex
- "^TUPLE: +\\([^ \n]+\\) +< +\\([^ \n]+\\)\\_>")
-
-(defconst fuel-syntax--constructor-regex "<[^ >]+>")
-
-(defconst fuel-syntax--getter-regex "\\(^\\|\\_<\\)[^ ]+?>>\\_>")
-(defconst fuel-syntax--setter-regex "\\_<>>.+?\\_>")
-
-(defconst fuel-syntax--symbol-definition-regex
- (fuel-syntax--second-word-regex '("&:" "SYMBOL:" "VAR:")))
-
-(defconst fuel-syntax--stack-effect-regex
- "\\( ( [^\n]* )\\)\\|\\( (( [^\n]* ))\\)")
-
-(defconst fuel-syntax--using-lines-regex "^USING: +\\([^;]+\\);")
-
-(defconst fuel-syntax--use-line-regex "^USE: +\\(.*\\)$")
-
-(defconst fuel-syntax--current-vocab-regex "^IN: +\\([^ \r\n\f]+\\)")
-
-(defconst fuel-syntax--sub-vocab-regex "^<\\([^ \n]+\\) *$")
-
-(defconst fuel-syntax--alien-function-regex
- "\\_<FUNCTION: \\(\\w+\\) \\(\\w+\\)")
-
-(defconst fuel-syntax--alien-callback-regex
- "\\_<CALLBACK: \\(\\w+\\) \\(\\w+\\)")
-
-(defconst fuel-syntax--indent-def-starts '("" ":"
- "C-ENUM" "C-STRUCT" "C-UNION"
- "FROM" "FUNCTION:"
- "INTERSECTION:"
- "M" "M:" "MACRO" "MACRO:"
- "MEMO" "MEMO:" "METHOD"
- "SYNTAX"
- "PREDICATE" "PRIMITIVE"
- "STRUCT" "TAG" "TUPLE"
- "TYPED" "TYPED:"
- "UNIFORM-TUPLE"
- "UNION-STRUCT" "UNION"
- "VERTEX-FORMAT"))
-
-(defconst fuel-syntax--no-indent-def-starts '("ARTICLE"
- "HELP"
- "SINGLETONS"
- "SPECIALIZED-ARRAYS"
- "SYMBOLS"
- "VARS"))
-
-(defconst fuel-syntax--indent-def-start-regex
- (format "^\\(%s:\\)\\( \\|\n\\)" (regexp-opt fuel-syntax--indent-def-starts)))
-
-(defconst fuel-syntax--definition-start-regex
- (format "^\\(%s:\\) " (regexp-opt (append fuel-syntax--no-indent-def-starts
- fuel-syntax--indent-def-starts))))
-
-(defconst fuel-syntax--definition-end-regex
- (format "\\(\\(^\\| +\\);\\( *%s\\)*\\($\\| +\\)\\)"
- fuel-syntax--declaration-words-regex))
-
-(defconst fuel-syntax--single-liner-regex
- (regexp-opt '("ABOUT:"
- "ALIAS:"
- "CONSTANT:" "C:" "C-TYPE:"
- "DEFER:"
- "FORGET:"
- "GAME:" "GENERIC:" "GENERIC#" "GLSL-PROGRAM:"
- "HEX:" "HOOK:"
- "IN:" "INSTANCE:"
- "LIBRARY:"
- "MAIN:" "MATH:" "MIXIN:"
- "OCT:"
- "POSTPONE:" "PRIVATE>" "<PRIVATE"
- "QUALIFIED-WITH:" "QUALIFIED:"
- "RENAME:"
- "SINGLETON:" "SLOT:" "SPECIALIZED-ARRAY:" "SYMBOL:"
- "TYPEDEF:"
- "USE:"
- "VAR:")))
-
-(defconst fuel-syntax--begin-of-def-regex
- (format "^USING: \\|\\(%s\\)\\|\\(^%s .*\\)"
- fuel-syntax--definition-start-regex
- fuel-syntax--single-liner-regex))
-
-(defconst fuel-syntax--end-of-def-line-regex
- (format "^.*%s" fuel-syntax--definition-end-regex))
-
-(defconst fuel-syntax--end-of-def-regex
- (format "\\(%s\\)\\|\\(^%s .*\\)"
- fuel-syntax--end-of-def-line-regex
- fuel-syntax--single-liner-regex))
-
-(defconst fuel-syntax--word-signature-regex
- (format ":[^ ]* \\([^ ]+\\)\\(%s\\)*" fuel-syntax--stack-effect-regex))
-
-(defconst fuel-syntax--defun-signature-regex
- (format "\\(%s\\|%s\\)"
- fuel-syntax--word-signature-regex
- "M[^:]*: [^ ]+ [^ ]+"))
-
-(defconst fuel-syntax--constructor-decl-regex
- "\\_<C: +\\(\\w+\\) +\\(\\w+\\)\\( .*\\)?$")
-
-(defconst fuel-syntax--typedef-regex
- "\\_<TYPEDEF: +\\(\\w+\\) +\\(\\w+\\)\\( .*\\)?$")
-
-(defconst fuel-syntax--rename-regex
- "\\_<RENAME: +\\(\\w+\\) +\\(\\w+\\) +=> +\\(\\w+\\)\\( .*\\)?$")
-
-\f
-;;; Factor syntax table
-
-(setq fuel-syntax--syntax-table
- (let ((table (make-syntax-table)))
- ;; Default is word constituent
- (dotimes (i 256)
- (modify-syntax-entry i "w" table))
- ;; Whitespace (TAB is not whitespace)
- (modify-syntax-entry ?\f " " table)
- (modify-syntax-entry ?\r " " table)
- (modify-syntax-entry ?\ " " table)
- (modify-syntax-entry ?\n " " table)
- table))
-
-(defconst fuel-syntax--syntactic-keywords
- `(;; Strings and chars
- ("\\_<<\\(\"\\)\\_>" (1 "<b"))
- ("\\_<\\(\"\\)>\\_>" (1 ">b"))
- ("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)?\\(\"\\)\\(\\([^\n\r\f\"\\]\\|\\\\.\\)*\\)\\(\"\\)"
- (3 "\"") (6 "\""))
- ("CHAR: \\(\"\\) [^\\\"]*?\\(\"\\)\\([^\\\"]\\|\\\\.\\)*?\\(\"\\)"
- (1 "w") (2 "<b") (4 ">b"))
- ("\\(CHAR:\\|\\\\\\) \\(\\w\\|!\\)\\( \\|$\\)" (2 "w"))
- ;; Comments
- ("\\_<\\(#?!\\) .*\\(\n\\|$\\)" (1 "<") (2 ">"))
- ("\\_<\\(#?!\\)\\(\n\\|$\\)" (1 "<") (2 ">"))
- ;; postpone
- ("\\_<POSTPONE:\\( \\).*\\(\n\\)" (1 "<b") (2 ">b"))
- ;; Multiline constructs
- ("\\_<\\(E\\)BNF:\\( \\|\n\\)" (1 "<b"))
- ("\\_<;EBN\\(F\\)\\_>" (1 ">b"))
- ("\\_<\\(U\\)SING: \\(;\\)" (1 "<b") (2 ">b"))
- ("\\_<USING:\\( \\)" (1 "<b"))
- ("\\_<\\(C\\)-ENUM: \\(;\\)" (1 "<b") (2 ">b"))
- ("\\_<C-ENUM:\\( \\|\n\\)" (1 "<b"))
- ("\\_<TUPLE: +\\w+? +< +\\w+? *\\( \\|\n\\)\\([^;]\\|$\\)" (1 "<b"))
- ("\\_<TUPLE: +\\w+? *\\( \\|\n\\)\\([^;<\n]\\|\\_>\\)" (1 "<b"))
- ("\\_<\\(SYMBOLS\\|VARS\\|SPECIALIZED-ARRAYS\\|SINGLETONS\\): *?\\( \\|\n\\)\\([^;\n]\\|\\_>\\)"
- (2 "<b"))
- ("\\(\n\\| \\);\\_>" (1 ">b"))
- ;; Let and lambda:
- ("\\_<\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))
- ("\\(\\[\\)\\(let\\|let\\*\\)\\( \\|$\\)" (1 "(]"))
- ("\\(\\[\\)\\(|\\) +[^|]* \\(|\\)" (1 "(]") (2 "(|") (3 ")|"))
- (" \\(|\\) " (1 "(|"))
- (" \\(|\\)$" (1 ")"))
- ;; Opening brace words:
- ("\\_<\\w*\\({\\)\\_>" (1 "(}"))
- ("\\_<\\(}\\)\\_>" (1 "){"))
- ;; Parenthesis:
- ("\\_<\\((\\)\\_>" (1 "()"))
- ("\\_<\\w*\\((\\)\\_>" (1 "()"))
- ("\\_<\\()\\)\\_>" (1 ")("))
- ("\\_<(\\((\\)\\_>" (1 "()"))
- ("\\_<\\()\\))\\_>" (1 ")("))
- ;; Quotations:
- ("\\_<'\\(\\[\\)\\_>" (1 "(]")) ; fried
- ("\\_<$\\(\\[\\)\\_>" (1 "(]")) ; parse-time
- ("\\_<\\(\\[\\)\\_>" (1 "(]"))
- ("\\_<\\(\\]\\)\\_>" (1 ")["))))
-
-\f
-;;; Source code analysis:
-
-(defsubst fuel-syntax--brackets-depth ()
- (nth 0 (syntax-ppss)))
-
-(defsubst fuel-syntax--brackets-start ()
- (nth 1 (syntax-ppss)))
-
-(defun fuel-syntax--brackets-end ()
- (save-excursion
- (goto-char (fuel-syntax--brackets-start))
- (condition-case nil
- (progn (forward-sexp)
- (1- (point)))
- (error -1))))
-
-(defsubst fuel-syntax--indentation-at (pos)
- (save-excursion (goto-char pos) (current-indentation)))
-
-(defsubst fuel-syntax--increased-indentation (&optional i)
- (+ (or i (current-indentation)) factor-indent-width))
-(defsubst fuel-syntax--decreased-indentation (&optional i)
- (- (or i (current-indentation)) factor-indent-width))
-
-(defsubst fuel-syntax--at-begin-of-def ()
- (looking-at fuel-syntax--begin-of-def-regex))
-
-(defsubst fuel-syntax--at-begin-of-indent-def ()
- (looking-at fuel-syntax--indent-def-start-regex))
-
-(defsubst fuel-syntax--at-end-of-def ()
- (looking-at fuel-syntax--end-of-def-regex))
-
-(defsubst fuel-syntax--looking-at-emptiness ()
- (looking-at "^[ ]*$\\|$"))
-
-(defsubst fuel-syntax--is-last-char (pos)
- (save-excursion
- (goto-char (1+ pos))
- (looking-at-p "[ ]*$")))
-
-(defsubst fuel-syntax--line-offset (pos)
- (- pos (save-excursion
- (goto-char pos)
- (beginning-of-line)
- (point))))
-
-(defun fuel-syntax--previous-non-blank ()
- (forward-line -1)
- (while (and (not (bobp)) (fuel-syntax--looking-at-emptiness))
- (forward-line -1)))
-
-(defun fuel-syntax--beginning-of-block-pos ()
- (save-excursion
- (if (> (fuel-syntax--brackets-depth) 0)
- (fuel-syntax--brackets-start)
- (fuel-syntax--beginning-of-defun)
- (point))))
-
-(defun fuel-syntax--at-setter-line ()
- (save-excursion
- (beginning-of-line)
- (when (re-search-forward fuel-syntax--setter-regex
- (line-end-position)
- t)
- (let* ((to (match-beginning 0))
- (from (fuel-syntax--beginning-of-block-pos)))
- (goto-char from)
- (let ((depth (fuel-syntax--brackets-depth)))
- (and (or (re-search-forward fuel-syntax--constructor-regex to t)
- (re-search-forward fuel-syntax--setter-regex to t))
- (= depth (fuel-syntax--brackets-depth))))))))
-
-(defun fuel-syntax--at-constructor-line ()
- (save-excursion
- (beginning-of-line)
- (re-search-forward fuel-syntax--constructor-regex (line-end-position) t)))
-
-(defsubst fuel-syntax--at-using ()
- (looking-at fuel-syntax--using-lines-regex))
-
-(defun fuel-syntax--in-using ()
- (let ((p (point)))
- (save-excursion
- (and (re-search-backward "^USING: " nil t)
- (re-search-forward " ;" nil t)
- (< p (match-end 0))))))
-
-(defsubst fuel-syntax--beginning-of-defun (&optional times)
- (re-search-backward fuel-syntax--begin-of-def-regex nil t times))
-
-(defsubst fuel-syntax--end-of-defun ()
- (re-search-forward fuel-syntax--end-of-def-regex nil t))
-
-(defsubst fuel-syntax--end-of-defun-pos ()
- (save-excursion
- (re-search-forward fuel-syntax--end-of-def-regex nil t)
- (point)))
-
-(defun fuel-syntax--beginning-of-body ()
- (let ((p (point)))
- (and (fuel-syntax--beginning-of-defun)
- (re-search-forward fuel-syntax--defun-signature-regex p t)
- (not (re-search-forward fuel-syntax--end-of-def-regex p t)))))
-
-(defun fuel-syntax--beginning-of-sexp ()
- (if (> (fuel-syntax--brackets-depth) 0)
- (goto-char (fuel-syntax--brackets-start))
- (fuel-syntax--beginning-of-body)))
-
-(defsubst fuel-syntax--beginning-of-sexp-pos ()
- (save-excursion (fuel-syntax--beginning-of-sexp) (point)))
-
-\f
-;;; USING/IN:
-
-(make-variable-buffer-local
- (defvar fuel-syntax--current-vocab-function 'fuel-syntax--find-in))
-
-(defsubst fuel-syntax--current-vocab ()
- (funcall fuel-syntax--current-vocab-function))
-
-(defun fuel-syntax--find-in ()
- (save-excursion
- (when (re-search-backward fuel-syntax--current-vocab-regex nil t)
- (match-string-no-properties 1))))
-
-(make-variable-buffer-local
- (defvar fuel-syntax--usings-function 'fuel-syntax--find-usings))
-
-(defsubst fuel-syntax--usings ()
- (funcall fuel-syntax--usings-function))
-
-(defun fuel-syntax--file-has-private ()
- (save-excursion
- (goto-char (point-min))
- (and (re-search-forward "\\_<<PRIVATE\\_>" nil t)
- (re-search-forward "\\_<PRIVATE>\\_>" nil t))))
-
-(defun fuel-syntax--find-usings (&optional no-private)
- (save-excursion
- (let ((usings))
- (goto-char (point-max))
- (while (re-search-backward fuel-syntax--using-lines-regex nil t)
- (dolist (u (split-string (match-string-no-properties 1) nil t))
- (push u usings)))
- (when (and (not no-private) (fuel-syntax--file-has-private))
- (goto-char (point-max))
- (push (concat (fuel-syntax--find-in) ".private") usings))
- usings)))
-
-\f
-(provide 'fuel-syntax)
-;;; fuel-syntax.el ends here
+;;; fuel-syntax.el --- auxiliar definitions for factor code navigation.\r
+\r
+;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz\r
+;; See http://factorcode.org/license.txt for BSD license.\r
+\r
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>\r
+;; Keywords: languages\r
+\r
+;;; Commentary:\r
+\r
+;; Auxiliar constants and functions to parse factor code.\r
+\r
+;;; Code:\r
+\r
+(require 'thingatpt)\r
+\r
+\f\r
+;;; Thing-at-point support for factor symbols:\r
+\r
+(defun fuel-syntax--beginning-of-symbol ()\r
+ "Move point to the beginning of the current symbol."\r
+ (skip-syntax-backward "w_()"))\r
+\r
+(defsubst fuel-syntax--beginning-of-symbol-pos ()\r
+ (save-excursion (fuel-syntax--beginning-of-symbol) (point)))\r
+\r
+(defun fuel-syntax--end-of-symbol ()\r
+ "Move point to the end of the current symbol."\r
+ (skip-syntax-forward "w_()"))\r
+\r
+(defsubst fuel-syntax--end-of-symbol-pos ()\r
+ (save-excursion (fuel-syntax--end-of-symbol) (point)))\r
+\r
+(put 'factor-symbol 'end-op 'fuel-syntax--end-of-symbol)\r
+(put 'factor-symbol 'beginning-op 'fuel-syntax--beginning-of-symbol)\r
+\r
+(defsubst fuel-syntax-symbol-at-point ()\r
+ (let ((s (substring-no-properties (thing-at-point 'factor-symbol))))\r
+ (and (> (length s) 0) s)))\r
+\r
+\r
+\f\r
+;;; Regexps galore:\r
+\r
+(defconst fuel-syntax--parsing-words\r
+ '(":" "::" ";" "&:" "<<" "<PRIVATE" ">>"\r
+ "ABOUT:" "ALIAS:" "ALIEN:" "ARTICLE:"\r
+ "B" "BIN:"\r
+ "C:" "CALLBACK:" "C-ENUM:" "C-STRUCT:" "C-TYPE:" "C-UNION:" "CHAR:" "COM-INTERFACE:" "CONSTANT:" "call-next-method"\r
+ "DEFER:"\r
+ "EBNF:" ";EBNF" "ERROR:" "EXCLUDE:"\r
+ "f" "FORGET:" "FROM:" "FUNCTION:"\r
+ "GAME:" "GENERIC#" "GENERIC:"\r
+ "GLSL-SHADER:" "GLSL-PROGRAM:"\r
+ "HELP:" "HEX:" "HOOK:"\r
+ "IN:" "initial:" "INSTANCE:" "INTERSECTION:"\r
+ "LIBRARY:"\r
+ "M:" "M::" "MACRO:" "MACRO::" "MAIN:" "MATH:"\r
+ "MEMO:" "MEMO:" "METHOD:" "MIXIN:"\r
+ "OCT:"\r
+ "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:"\r
+ "QUALIFIED-WITH:" "QUALIFIED:"\r
+ "read-only" "RENAME:" "REQUIRE:" "REQUIRES:"\r
+ "SINGLETON:" "SINGLETONS:" "SLOT:" "SPECIALIZED-ARRAY:" "SPECIALIZED-ARRAYS:" "STRING:" "STRUCT:" "SYMBOL:" "SYMBOLS:" "SYNTAX:"\r
+ "TUPLE:" "t" "t?" "TYPEDEF:" "TYPED:" "TYPED::"\r
+ "UNIFORM-TUPLE:" "UNION:" "UNION-STRUCT:" "USE:" "USING:"\r
+ "VARS:" "VERTEX-FORMAT:"))\r
+\r
+(defconst fuel-syntax--parsing-words-regex\r
+ (regexp-opt fuel-syntax--parsing-words 'words))\r
+\r
+(defconst fuel-syntax--bracers\r
+ '("B" "BV" "C" "CS" "H" "T" "V" "W"))\r
+\r
+(defconst fuel-syntax--brace-words-regex\r
+ (format "%s{" (regexp-opt fuel-syntax--bracers t)))\r
+\r
+(defconst fuel-syntax--declaration-words\r
+ '("flushable" "foldable" "inline" "parsing" "recursive" "delimiter"))\r
+\r
+(defconst fuel-syntax--declaration-words-regex\r
+ (regexp-opt fuel-syntax--declaration-words 'words))\r
+\r
+(defsubst fuel-syntax--second-word-regex (prefixes)\r
+ (format "%s +\\([^ \r\n]+\\)" (regexp-opt prefixes t)))\r
+\r
+(defconst fuel-syntax--method-definition-regex\r
+ "^M::? +\\([^ ]+\\) +\\([^ ]+\\)")\r
+\r
+(defconst fuel-syntax--integer-regex\r
+ "\\_<-?[0-9]+\\_>")\r
+\r
+(defconst fuel-syntax--raw-float-regex\r
+ "[0-9]*\\.[0-9]*\\([eE][+-]?[0-9]+\\)?")\r
+\r
+(defconst fuel-syntax--float-regex\r
+ (format "\\_<-?%s\\_>" fuel-syntax--raw-float-regex))\r
+\r
+(defconst fuel-syntax--number-regex\r
+ (format "\\([0-9]+\\|%s\\)" fuel-syntax--raw-float-regex))\r
+\r
+(defconst fuel-syntax--ratio-regex\r
+ (format "\\_<[+-]?%s/-?%s\\_>"\r
+ fuel-syntax--number-regex\r
+ fuel-syntax--number-regex))\r
+\r
+(defconst fuel-syntax--bad-string-regex\r
+ "\\_<\"[^>]\\([^\"\n]\\|\\\\\"\\)*\n")\r
+\r
+(defconst fuel-syntax--word-definition-regex\r
+ (format "\\_<\\(%s\\)?: +\\_<\\(\\w+\\)\\_>"\r
+ (regexp-opt\r
+ '(":" "GENERIC" "DEFER" "HOOK" "MAIN" "MATH" "POSTPONE"\r
+ "SYMBOL" "SYNTAX" "TYPED" "RENAME"))))\r
+\r
+(defconst fuel-syntax--alias-definition-regex\r
+ "^ALIAS: +\\(\\_<.+?\\_>\\) +\\(\\_<.+?\\_>\\)")\r
+\r
+(defconst fuel-syntax--vocab-ref-regexp\r
+ (fuel-syntax--second-word-regex\r
+ '("IN:" "USE:" "FROM:" "EXCLUDE:" "QUALIFIED:" "QUALIFIED-WITH:")))\r
+\r
+(defconst fuel-syntax--int-constant-def-regex\r
+ (fuel-syntax--second-word-regex '("ALIEN:" "CHAR:" "BIN:" "HEX:" "OCT:")))\r
+\r
+(defconst fuel-syntax--type-definition-regex\r
+ (fuel-syntax--second-word-regex\r
+ '("C-STRUCT:" "C-UNION:" "COM-INTERFACE:" "MIXIN:" "TUPLE:" "SINGLETON:" "SPECIALIZED-ARRAY:" "STRUCT:" "UNION:" "UNION-STRUCT:")))\r
+\r
+(defconst fuel-syntax--tuple-decl-regex\r
+ "^TUPLE: +\\([^ \n]+\\) +< +\\([^ \n]+\\)\\_>")\r
+\r
+(defconst fuel-syntax--constructor-regex "<[^ >]+>")\r
+\r
+(defconst fuel-syntax--getter-regex "\\(^\\|\\_<\\)[^ ]+?>>\\_>")\r
+(defconst fuel-syntax--setter-regex "\\_<>>.+?\\_>")\r
+\r
+(defconst fuel-syntax--symbol-definition-regex\r
+ (fuel-syntax--second-word-regex '("&:" "SYMBOL:" "VAR:")))\r
+\r
+(defconst fuel-syntax--stack-effect-regex\r
+ "\\( ( [^\n]* )\\)\\|\\( (( [^\n]* ))\\)")\r
+\r
+(defconst fuel-syntax--using-lines-regex "^USING: +\\([^;]+\\);")\r
+\r
+(defconst fuel-syntax--use-line-regex "^USE: +\\(.*\\)$")\r
+\r
+(defconst fuel-syntax--current-vocab-regex "^IN: +\\([^ \r\n\f]+\\)")\r
+\r
+(defconst fuel-syntax--sub-vocab-regex "^<\\([^ \n]+\\) *$")\r
+\r
+(defconst fuel-syntax--alien-function-regex\r
+ "\\_<FUNCTION: \\(\\w+\\) \\(\\w+\\)")\r
+\r
+(defconst fuel-syntax--alien-callback-regex\r
+ "\\_<CALLBACK: \\(\\w+\\) \\(\\w+\\)")\r
+\r
+(defconst fuel-syntax--indent-def-starts '("" ":"\r
+ "C-ENUM" "C-STRUCT" "C-UNION" "COM-INTERFACE"\r
+ "FROM" "FUNCTION:"\r
+ "INTERSECTION:"\r
+ "M" "M:" "MACRO" "MACRO:"\r
+ "MEMO" "MEMO:" "METHOD"\r
+ "SYNTAX"\r
+ "PREDICATE" "PRIMITIVE"\r
+ "STRUCT" "TAG" "TUPLE"\r
+ "TYPED" "TYPED:"\r
+ "UNIFORM-TUPLE"\r
+ "UNION-STRUCT" "UNION"\r
+ "VERTEX-FORMAT"))\r
+\r
+(defconst fuel-syntax--no-indent-def-starts '("ARTICLE"\r
+ "HELP"\r
+ "SINGLETONS"\r
+ "SPECIALIZED-ARRAYS"\r
+ "SYMBOLS"\r
+ "VARS"))\r
+\r
+(defconst fuel-syntax--indent-def-start-regex\r
+ (format "^\\(%s:\\)\\( \\|\n\\)" (regexp-opt fuel-syntax--indent-def-starts)))\r
+\r
+(defconst fuel-syntax--definition-start-regex\r
+ (format "^\\(%s:\\) " (regexp-opt (append fuel-syntax--no-indent-def-starts\r
+ fuel-syntax--indent-def-starts))))\r
+\r
+(defconst fuel-syntax--definition-end-regex\r
+ (format "\\(\\(^\\| +\\);\\( *%s\\)*\\($\\| +\\)\\)"\r
+ fuel-syntax--declaration-words-regex))\r
+\r
+(defconst fuel-syntax--single-liner-regex\r
+ (regexp-opt '("ABOUT:"\r
+ "ALIAS:"\r
+ "CONSTANT:" "C:" "C-TYPE:"\r
+ "DEFER:"\r
+ "FORGET:"\r
+ "GAME:" "GENERIC:" "GENERIC#" "GLSL-PROGRAM:" \r
+ "HEX:" "HOOK:"\r
+ "IN:" "INSTANCE:"\r
+ "LIBRARY:"\r
+ "MAIN:" "MATH:" "MIXIN:"\r
+ "OCT:"\r
+ "POSTPONE:" "PRIVATE>" "<PRIVATE"\r
+ "QUALIFIED-WITH:" "QUALIFIED:"\r
+ "RENAME:"\r
+ "SINGLETON:" "SLOT:" "SPECIALIZED-ARRAY:" "SYMBOL:"\r
+ "TYPEDEF:"\r
+ "USE:"\r
+ "VAR:")))\r
+\r
+(defconst fuel-syntax--begin-of-def-regex\r
+ (format "^USING: \\|\\(%s\\)\\|\\(^%s .*\\)"\r
+ fuel-syntax--definition-start-regex\r
+ fuel-syntax--single-liner-regex))\r
+\r
+(defconst fuel-syntax--end-of-def-line-regex\r
+ (format "^.*%s" fuel-syntax--definition-end-regex))\r
+\r
+(defconst fuel-syntax--end-of-def-regex\r
+ (format "\\(%s\\)\\|\\(^%s .*\\)"\r
+ fuel-syntax--end-of-def-line-regex\r
+ fuel-syntax--single-liner-regex))\r
+\r
+(defconst fuel-syntax--word-signature-regex\r
+ (format ":[^ ]* \\([^ ]+\\)\\(%s\\)*" fuel-syntax--stack-effect-regex))\r
+\r
+(defconst fuel-syntax--defun-signature-regex\r
+ (format "\\(%s\\|%s\\)"\r
+ fuel-syntax--word-signature-regex\r
+ "M[^:]*: [^ ]+ [^ ]+"))\r
+\r
+(defconst fuel-syntax--constructor-decl-regex\r
+ "\\_<C: +\\(\\w+\\) +\\(\\w+\\)\\( .*\\)?$")\r
+\r
+(defconst fuel-syntax--typedef-regex\r
+ "\\_<TYPEDEF: +\\(\\w+\\) +\\(\\w+\\)\\( .*\\)?$")\r
+\r
+(defconst fuel-syntax--rename-regex\r
+ "\\_<RENAME: +\\(\\w+\\) +\\(\\w+\\) +=> +\\(\\w+\\)\\( .*\\)?$")\r
+\r
+\f\r
+;;; Factor syntax table\r
+\r
+(setq fuel-syntax--syntax-table\r
+ (let ((table (make-syntax-table)))\r
+ ;; Default is word constituent\r
+ (dotimes (i 256)\r
+ (modify-syntax-entry i "w" table))\r
+ ;; Whitespace (TAB is not whitespace)\r
+ (modify-syntax-entry ?\f " " table)\r
+ (modify-syntax-entry ?\r " " table)\r
+ (modify-syntax-entry ?\ " " table)\r
+ (modify-syntax-entry ?\n " " table)\r
+ table))\r
+\r
+(defconst fuel-syntax--syntactic-keywords\r
+ `(;; Strings and chars\r
+ ("\\_<<\\(\"\\)\\_>" (1 "<b"))\r
+ ("\\_<\\(\"\\)>\\_>" (1 ">b"))\r
+ ("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)?\\(\"\\)\\(\\([^\n\r\f\"\\]\\|\\\\.\\)*\\)\\(\"\\)"\r
+ (3 "\"") (6 "\""))\r
+ ("CHAR: \\(\"\\) [^\\\"]*?\\(\"\\)\\([^\\\"]\\|\\\\.\\)*?\\(\"\\)"\r
+ (1 "w") (2 "<b") (4 ">b"))\r
+ ("\\(CHAR:\\|\\\\\\) \\(\\w\\|!\\)\\( \\|$\\)" (2 "w"))\r
+ ;; Comments\r
+ ("\\_<\\(#?!\\) .*\\(\n\\|$\\)" (1 "<") (2 ">"))\r
+ ("\\_<\\(#?!\\)\\(\n\\|$\\)" (1 "<") (2 ">"))\r
+ ;; postpone\r
+ ("\\_<POSTPONE:\\( \\).*\\(\n\\)" (1 "<b") (2 ">b"))\r
+ ;; Multiline constructs\r
+ ("\\_<\\(E\\)BNF:\\( \\|\n\\)" (1 "<b"))\r
+ ("\\_<;EBN\\(F\\)\\_>" (1 ">b"))\r
+ ("\\_<\\(U\\)SING: \\(;\\)" (1 "<b") (2 ">b"))\r
+ ("\\_<USING:\\( \\)" (1 "<b"))\r
+ ("\\_<\\(C\\)-ENUM: \\(;\\)" (1 "<b") (2 ">b"))\r
+ ("\\_<C-ENUM:\\( \\|\n\\)" (1 "<b"))\r
+ ("\\_<TUPLE: +\\w+? +< +\\w+? *\\( \\|\n\\)\\([^;]\\|$\\)" (1 "<b"))\r
+ ("\\_<TUPLE: +\\w+? *\\( \\|\n\\)\\([^;<\n]\\|\\_>\\)" (1 "<b"))\r
+ ("\\_<\\(SYMBOLS\\|VARS\\|SPECIALIZED-ARRAYS\\|SINGLETONS\\): *?\\( \\|\n\\)\\([^;\n]\\|\\_>\\)"\r
+ (2 "<b"))\r
+ ("\\(\n\\| \\);\\_>" (1 ">b"))\r
+ ;; Let and lambda:\r
+ ("\\_<\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))\r
+ ("\\(\\[\\)\\(let\\|let\\*\\)\\( \\|$\\)" (1 "(]"))\r
+ ("\\(\\[\\)\\(|\\) +[^|]* \\(|\\)" (1 "(]") (2 "(|") (3 ")|"))\r
+ (" \\(|\\) " (1 "(|"))\r
+ (" \\(|\\)$" (1 ")"))\r
+ ;; Opening brace words:\r
+ ("\\_<\\w*\\({\\)\\_>" (1 "(}"))\r
+ ("\\_<\\(}\\)\\_>" (1 "){"))\r
+ ;; Parenthesis:\r
+ ("\\_<\\((\\)\\_>" (1 "()"))\r
+ ("\\_<\\w*\\((\\)\\_>" (1 "()"))\r
+ ("\\_<\\()\\)\\_>" (1 ")("))\r
+ ("\\_<(\\((\\)\\_>" (1 "()"))\r
+ ("\\_<\\()\\))\\_>" (1 ")("))\r
+ ;; Quotations:\r
+ ("\\_<'\\(\\[\\)\\_>" (1 "(]")) ; fried\r
+ ("\\_<$\\(\\[\\)\\_>" (1 "(]")) ; parse-time\r
+ ("\\_<\\(\\[\\)\\_>" (1 "(]"))\r
+ ("\\_<\\(\\]\\)\\_>" (1 ")["))))\r
+\r
+\f\r
+;;; Source code analysis:\r
+\r
+(defsubst fuel-syntax--brackets-depth ()\r
+ (nth 0 (syntax-ppss)))\r
+\r
+(defsubst fuel-syntax--brackets-start ()\r
+ (nth 1 (syntax-ppss)))\r
+\r
+(defun fuel-syntax--brackets-end ()\r
+ (save-excursion\r
+ (goto-char (fuel-syntax--brackets-start))\r
+ (condition-case nil\r
+ (progn (forward-sexp)\r
+ (1- (point)))\r
+ (error -1))))\r
+\r
+(defsubst fuel-syntax--indentation-at (pos)\r
+ (save-excursion (goto-char pos) (current-indentation)))\r
+\r
+(defsubst fuel-syntax--increased-indentation (&optional i)\r
+ (+ (or i (current-indentation)) factor-indent-width))\r
+(defsubst fuel-syntax--decreased-indentation (&optional i)\r
+ (- (or i (current-indentation)) factor-indent-width))\r
+\r
+(defsubst fuel-syntax--at-begin-of-def ()\r
+ (looking-at fuel-syntax--begin-of-def-regex))\r
+\r
+(defsubst fuel-syntax--at-begin-of-indent-def ()\r
+ (looking-at fuel-syntax--indent-def-start-regex))\r
+\r
+(defsubst fuel-syntax--at-end-of-def ()\r
+ (looking-at fuel-syntax--end-of-def-regex))\r
+\r
+(defsubst fuel-syntax--looking-at-emptiness ()\r
+ (looking-at "^[ ]*$\\|$"))\r
+\r
+(defsubst fuel-syntax--is-last-char (pos)\r
+ (save-excursion\r
+ (goto-char (1+ pos))\r
+ (looking-at-p "[ ]*$")))\r
+\r
+(defsubst fuel-syntax--line-offset (pos)\r
+ (- pos (save-excursion\r
+ (goto-char pos)\r
+ (beginning-of-line)\r
+ (point))))\r
+\r
+(defun fuel-syntax--previous-non-blank ()\r
+ (forward-line -1)\r
+ (while (and (not (bobp)) (fuel-syntax--looking-at-emptiness))\r
+ (forward-line -1)))\r
+\r
+(defun fuel-syntax--beginning-of-block-pos ()\r
+ (save-excursion\r
+ (if (> (fuel-syntax--brackets-depth) 0)\r
+ (fuel-syntax--brackets-start)\r
+ (fuel-syntax--beginning-of-defun)\r
+ (point))))\r
+\r
+(defun fuel-syntax--at-setter-line ()\r
+ (save-excursion\r
+ (beginning-of-line)\r
+ (when (re-search-forward fuel-syntax--setter-regex\r
+ (line-end-position)\r
+ t)\r
+ (let* ((to (match-beginning 0))\r
+ (from (fuel-syntax--beginning-of-block-pos)))\r
+ (goto-char from)\r
+ (let ((depth (fuel-syntax--brackets-depth)))\r
+ (and (or (re-search-forward fuel-syntax--constructor-regex to t)\r
+ (re-search-forward fuel-syntax--setter-regex to t))\r
+ (= depth (fuel-syntax--brackets-depth))))))))\r
+\r
+(defun fuel-syntax--at-constructor-line ()\r
+ (save-excursion\r
+ (beginning-of-line)\r
+ (re-search-forward fuel-syntax--constructor-regex (line-end-position) t)))\r
+\r
+(defsubst fuel-syntax--at-using ()\r
+ (looking-at fuel-syntax--using-lines-regex))\r
+\r
+(defun fuel-syntax--in-using ()\r
+ (let ((p (point)))\r
+ (save-excursion\r
+ (and (re-search-backward "^USING: " nil t)\r
+ (re-search-forward " ;" nil t)\r
+ (< p (match-end 0))))))\r
+\r
+(defsubst fuel-syntax--beginning-of-defun (&optional times)\r
+ (re-search-backward fuel-syntax--begin-of-def-regex nil t times))\r
+\r
+(defsubst fuel-syntax--end-of-defun ()\r
+ (re-search-forward fuel-syntax--end-of-def-regex nil t))\r
+\r
+(defsubst fuel-syntax--end-of-defun-pos ()\r
+ (save-excursion\r
+ (re-search-forward fuel-syntax--end-of-def-regex nil t)\r
+ (point)))\r
+\r
+(defun fuel-syntax--beginning-of-body ()\r
+ (let ((p (point)))\r
+ (and (fuel-syntax--beginning-of-defun)\r
+ (re-search-forward fuel-syntax--defun-signature-regex p t)\r
+ (not (re-search-forward fuel-syntax--end-of-def-regex p t)))))\r
+\r
+(defun fuel-syntax--beginning-of-sexp ()\r
+ (if (> (fuel-syntax--brackets-depth) 0)\r
+ (goto-char (fuel-syntax--brackets-start))\r
+ (fuel-syntax--beginning-of-body)))\r
+\r
+(defsubst fuel-syntax--beginning-of-sexp-pos ()\r
+ (save-excursion (fuel-syntax--beginning-of-sexp) (point)))\r
+\r
+\f\r
+;;; USING/IN:\r
+\r
+(make-variable-buffer-local\r
+ (defvar fuel-syntax--current-vocab-function 'fuel-syntax--find-in))\r
+\r
+(defsubst fuel-syntax--current-vocab ()\r
+ (funcall fuel-syntax--current-vocab-function))\r
+\r
+(defun fuel-syntax--find-in ()\r
+ (save-excursion\r
+ (when (re-search-backward fuel-syntax--current-vocab-regex nil t)\r
+ (match-string-no-properties 1))))\r
+\r
+(make-variable-buffer-local\r
+ (defvar fuel-syntax--usings-function 'fuel-syntax--find-usings))\r
+\r
+(defsubst fuel-syntax--usings ()\r
+ (funcall fuel-syntax--usings-function))\r
+\r
+(defun fuel-syntax--file-has-private ()\r
+ (save-excursion\r
+ (goto-char (point-min))\r
+ (and (re-search-forward "\\_<<PRIVATE\\_>" nil t)\r
+ (re-search-forward "\\_<PRIVATE>\\_>" nil t))))\r
+\r
+(defun fuel-syntax--find-usings (&optional no-private)\r
+ (save-excursion\r
+ (let ((usings))\r
+ (goto-char (point-max))\r
+ (while (re-search-backward fuel-syntax--using-lines-regex nil t)\r
+ (dolist (u (split-string (match-string-no-properties 1) nil t))\r
+ (push u usings)))\r
+ (when (and (not no-private) (fuel-syntax--file-has-private))\r
+ (goto-char (point-max))\r
+ (push (concat (fuel-syntax--find-in) ".private") usings))\r
+ usings)))\r
+\r
+\f\r
+(provide 'fuel-syntax)\r
+;;; fuel-syntax.el ends here\r
--- /dev/null
+USING: assocs io.pathnames fry namespaces namespaces.private kernel sequences parser hashtables ;
+IN: closures
+SYMBOL: |
+
+! Selective Binding
+: delayed-bind-with ( vars quot -- quot' ) '[ _ dup [ get ] map zip >hashtable [ _ bind ] curry ] ;
+SYNTAX: C[ | parse-until parse-quotation delayed-bind-with append! ;
+! Common ones
+SYNTAX: DIR[ parse-quotation { current-directory } swap delayed-bind-with append! ;
+
+! Namespace Binding
+: bind-to-namespace ( quot -- quot' ) '[ namespace [ _ bind ] curry ] ;
+SYNTAX: NS[ parse-quotation bind-to-namespace append! ;
--- /dev/null
+USING: alien.strings io.encodings.utf16n windows.com\r
+windows.com.wrapper combinators windows.kernel32 windows.ole32\r
+windows.shell32 kernel accessors windows.types\r
+prettyprint namespaces ui.tools.listener ui.tools.workspace\r
+alien.data alien sequences math classes.struct ;\r
+SPECIALIZED-ARRAY: WCHAR\r
+IN: windows.dragdrop-listener\r
+\r
+: filenames-from-hdrop ( hdrop -- filenames )\r
+ dup HEX: FFFFFFFF f 0 DragQueryFile ! get count of files\r
+ [\r
+ 2dup f 0 DragQueryFile 1 + ! get size of filename buffer\r
+ dup WCHAR <c-array>\r
+ [ swap DragQueryFile drop ] keep\r
+ utf16n alien>string\r
+ ] with map ;\r
+\r
+: filenames-from-data-object ( data-object -- filenames )\r
+ FORMATETC <struct>\r
+ CF_HDROP >>cfFormat\r
+ f >>ptd\r
+ DVASPECT_CONTENT >>dwAspect\r
+ -1 >>lindex\r
+ TYMED_HGLOBAL >>tymed\r
+ STGMEDIUM <struct>\r
+ [ IDataObject::GetData ] keep swap succeeded? [\r
+ dup data>>\r
+ [ filenames-from-hdrop ] with-global-lock\r
+ swap ReleaseStgMedium\r
+ ] [ drop f ] if ;\r
+\r
+TUPLE: listener-dragdrop hWnd last-drop-effect ;\r
+\r
+: <listener-dragdrop> ( hWnd -- object )\r
+ DROPEFFECT_NONE listener-dragdrop construct-boa ;\r
+\r
+SYMBOL: +listener-dragdrop-wrapper+\r
+{\r
+ { "IDropTarget" {\r
+ [ ! DragEnter\r
+ [\r
+ 2drop\r
+ filenames-from-data-object\r
+ length 1 = [ DROPEFFECT_COPY ] [ DROPEFFECT_NONE ] if\r
+ dup 0\r
+ ] dip set-ulong-nth\r
+ >>last-drop-effect drop\r
+ S_OK\r
+ ] [ ! DragOver\r
+ [ 2drop last-drop-effect>> 0 ] dip set-ulong-nth\r
+ S_OK\r
+ ] [ ! DragLeave\r
+ drop S_OK\r
+ ] [ ! Drop\r
+ [\r
+ 2drop nip\r
+ filenames-from-data-object\r
+ dup length 1 = [\r
+ first unparse [ "USE: parser " % % " run-file" % ] "" make\r
+ eval-listener\r
+ DROPEFFECT_COPY\r
+ ] [ 2drop DROPEFFECT_NONE ] if\r
+ 0\r
+ ] dip set-ulong-nth\r
+ S_OK\r
+ ]\r
+ } }\r
+} <com-wrapper> +listener-dragdrop-wrapper+ set-global\r
+\r
+: dragdrop-listener-window ( -- )\r
+ get-workspace parent>> handle>> hWnd>>\r
+ dup <listener-dragdrop>\r
+ +listener-dragdrop-wrapper+ get-global com-wrap\r
+ [ RegisterDragDrop ole32-error ] with-com-interface ;\r
--- /dev/null
+Sam Anklesaria
\ No newline at end of file
--- /dev/null
+USING: arrays vectors combinators effects kernel math sequences splitting
+strings.parser parser fry sequences.extras ;
+
+! a b c glue => acb
+! c b a [ append ] dip prepend
+
+IN: fries
+: str-fry ( str on -- quot ) split
+ [ unclip-last [ [ [ append ] [ prepend ] bi* ] reduce-r ] 2curry ]
+ [ length 1 - 1 <effect> [ call-effect ] 2curry ] bi ;
+: gen-fry ( str on -- quot ) split
+ [ unclip-last [ [ [ 1array ] [ append ] [ prepend ] tri* ] reduce-r ] 2curry ]
+ [ length 1 - 1 <effect> [ call-effect ] 2curry ] bi ;
+
+SYNTAX: i" parse-string rest "_" str-fry append! ;
+SYNTAX: i{ \ } parse-until >array { _ } gen-fry append! ;
+SYNTAX: iV{ \ } parse-until >vector V{ _ } gen-fry append! ;
--- /dev/null
+Generalized Frying
\ No newline at end of file
--- /dev/null
+USING: accessors assocs fry generalizations kernel locals math
+namespaces parser sequences shuffle words effects.parser ;
+IN: set-n
+: get* ( var n -- val ) namestack dup length rot - head assoc-stack ;
+
+: set* ( val var n -- ) 1 + namestack [ length swap - ] keep nth set-at ;
+
+! dynamic lambda
+SYNTAX: :| (:) dup in>> dup length [ spin '[ _ narray _ swap zip _ bind ] ] 2curry dip define-declared ;
-fraptor ICON "misc/icons/Factor.ico"
+APPICON ICON "misc/icons/Factor.ico"
FILE *factor_vm::safe_fopen(char *filename, char *mode)
{
FILE *file;
- do {
+ for(;;)
+ {
file = fopen(filename,mode);
if(file == NULL)
io_error();
else
break;
- } while(errno == EINTR);
+ }
return file;
}
int factor_vm::safe_fgetc(FILE *stream)
{
int c;
- do {
+ for(;;)
+ {
c = fgetc(stream);
if(c == EOF)
{
}
else
break;
- } while(errno == EINTR);
+ }
return c;
}
size_t factor_vm::safe_fread(void *ptr, size_t size, size_t nitems, FILE *stream)
{
size_t items_read = 0;
+ size_t ret = 0;
- do {
- items_read += fread((void*)((int*)ptr+items_read*size),size,nitems-items_read,stream);
- } while(items_read != nitems && errno == EINTR);
+ do
+ {
+ ret = fread((void*)((int*)ptr+items_read*size),size,nitems-items_read,stream);
+ if(ret == 0)
+ {
+ if(feof(stream))
+ break;
+ else
+ io_error();
+ }
+ items_read += ret;
+ } while(items_read != nitems);
return items_read;
}
void factor_vm::safe_fputc(int c, FILE *stream)
{
- do {
+ for(;;)
+ {
if(fputc(c,stream) == EOF)
io_error();
else
break;
- } while(errno == EINTR);
+ }
}
size_t factor_vm::safe_fwrite(void *ptr, size_t size, size_t nitems, FILE *stream)
{
size_t items_written = 0;
+ size_t ret = 0;
do {
- items_written += fwrite((void*)((int*)ptr+items_written*size),size,nitems-items_written,stream);
- } while(items_written != nitems && errno == EINTR);
+ ret = fwrite((void*)((int*)ptr+items_written*size),size,nitems-items_written,stream);
+ if(ret == 0)
+ io_error();
+ items_written += ret;
+ } while(items_written != nitems);
return items_written;
}
int factor_vm::safe_ftell(FILE *stream)
{
off_t offset;
- do {
+ for(;;)
+ {
if((offset = FTELL(stream)) == -1)
io_error();
else
break;
- } while(errno == EINTR);
+ }
return offset;
}
critical_error("Bad value for whence",whence);
}
- do {
+ for(;;)
+ {
if(FSEEK(stream,offset,whence) == -1)
io_error();
else
break;
- } while(errno == EINTR);
+ }
}
void factor_vm::safe_fflush(FILE *stream)
{
- do {
+ for(;;)
+ {
if(fflush(stream) == EOF)
io_error();
else
break;
- } while(errno == EINTR);
+ }
}
void factor_vm::safe_fclose(FILE *stream)
{
- do {
+ for(;;)
+ {
if(fclose(stream) == EOF)
io_error();
else
break;
- } while(errno == EINTR);
+ }
}
void factor_vm::primitive_fopen()
int c = safe_fread(buf.untagged() + 1,1,size,file);
if(c == 0)
- {
- if(feof(file))
- ctx->push(false_object);
- else
- io_error();
- }
+ ctx->push(false_object);
else
{
if(feof(file))
void factor_vm::primitive_fwrite()
{
FILE *file = pop_file_handle();
- byte_array *text = untag_check<byte_array>(ctx->pop());
- cell length = array_capacity(text);
- char *string = (char *)(text + 1);
+ cell length = to_cell(ctx->pop());
+ char *text = alien_offset(ctx->pop());
if(length == 0)
return;
- size_t written = safe_fwrite(string,1,length,file);
+ size_t written = safe_fwrite(text,1,length,file);
if(written != length)
io_error();
}
void factor_vm::primitive_fseek()
{
- int whence = to_fixnum(ctx->pop());
FILE *file = pop_file_handle();
+ int whence = to_fixnum(ctx->pop());
off_t offset = to_signed_8(ctx->pop());
safe_fseek(file,offset,whence);
}
projects / factor.git / commitdiff