windows.dinput.constants: fix deployment

db4
Slava Pestov 2009-05-11 18:01:35 -05:00
parent 5b315efc81
commit 782cc78c14
2 changed files with 10 additions and 4 deletions

View File

@ -35,6 +35,6 @@ ERROR: bad-byte-array-length byte-array ;
heap-size struct-array boa ; inline heap-size struct-array boa ; inline
: malloc-struct-array ( length c-type -- struct-array ) : malloc-struct-array ( length c-type -- struct-array )
[ heap-size calloc ] 2keep <direct-struct-array> ; [ heap-size calloc ] 2keep <direct-struct-array> ; inline
INSTANCE: struct-array sequence INSTANCE: struct-array sequence

View File

@ -2,7 +2,7 @@ USING: windows.dinput windows.kernel32 windows.ole32 windows.com
windows.com.syntax alien alien.c-types alien.syntax kernel system namespaces windows.com.syntax alien alien.c-types alien.syntax kernel system namespaces
combinators sequences fry math accessors macros words quotations combinators sequences fry math accessors macros words quotations
libc continuations generalizations splitting locals assocs init libc continuations generalizations splitting locals assocs init
struct-arrays ; struct-arrays memoize ;
IN: windows.dinput.constants IN: windows.dinput.constants
! Some global variables aren't provided by the DirectInput DLL (they're in the ! Some global variables aren't provided by the DirectInput DLL (they're in the
@ -18,12 +18,15 @@ SYMBOLS:
<PRIVATE <PRIVATE
MEMO: c-type* ( name -- c-type ) c-type ;
MEMO: heap-size* ( c-type -- n ) heap-size ;
: (field-spec-of) ( field struct -- field-spec ) : (field-spec-of) ( field struct -- field-spec )
c-type fields>> [ name>> = ] with find nip ; c-type* fields>> [ name>> = ] with find nip ;
: (offsetof) ( field struct -- offset ) : (offsetof) ( field struct -- offset )
[ (field-spec-of) offset>> ] [ drop 0 ] if* ; [ (field-spec-of) offset>> ] [ drop 0 ] if* ;
: (sizeof) ( field struct -- size ) : (sizeof) ( field struct -- size )
[ (field-spec-of) type>> "[" split1 drop heap-size ] [ drop 1 ] if* ; [ (field-spec-of) type>> "[" split1 drop heap-size* ] [ drop 1 ] if* ;
: (flag) ( thing -- integer ) : (flag) ( thing -- integer )
{ {
@ -79,6 +82,9 @@ SYMBOLS:
[ nip length ] [ malloc-DIOBJECTDATAFORMAT-array ] 2bi [ nip length ] [ malloc-DIOBJECTDATAFORMAT-array ] 2bi
"DIDATAFORMAT" <c-object> (DIDATAFORMAT) ; "DIDATAFORMAT" <c-object> (DIDATAFORMAT) ;
: initialize ( symbol quot -- )
call swap set-global ; inline
: (malloc-guid-symbol) ( symbol guid -- ) : (malloc-guid-symbol) ( symbol guid -- )
'[ '[
_ execute( -- value ) _ execute( -- value )