-USING: alien alien.syntax alien.c-types kernel tools.test
-sequences system libc alien.strings io.encodings.utf8
-math.constants ;
+USING: alien alien.syntax alien.c-types alien.parser
+kernel tools.test sequences system libc alien.strings
+io.encodings.utf8 math.constants classes.struct ;
IN: alien.c-types.tests
CONSTANT: xyz 123
-[ 492 ] [ { "int" xyz } heap-size ] unit-test
+[ 492 ] [ { int xyz } heap-size ] unit-test
[ -1 ] [ -1 <char> *char ] unit-test
[ -1 ] [ -1 <short> *short ] unit-test
[ -1 ] [ -1 <int> *int ] unit-test
-C-UNION: foo
- "int"
- "int" ;
+UNION-STRUCT: foo
+ { a int }
+ { b int } ;
-[ f ] [ "char*" c-type "void*" c-type eq? ] unit-test
-[ t ] [ "char**" c-type "void*" c-type eq? ] unit-test
+[ f ] [ "char*" parse-c-type c-type void* c-type eq? ] unit-test
+[ t ] [ "char**" parse-c-type c-type void* c-type eq? ] unit-test
-[ t ] [ "foo" heap-size "int" heap-size = ] 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*" c-type eq? ] unit-test
+[ t ] [ int c-type MyInt c-type eq? ] unit-test
+[ t ] [ void* c-type "MyInt*" parse-c-type c-type eq? ] unit-test
TYPEDEF: char MyChar
-[ t ] [ "char" c-type "MyChar" c-type eq? ] unit-test
-[ f ] [ "void*" c-type "MyChar*" c-type eq? ] unit-test
-[ t ] [ "char*" c-type "MyChar*" c-type eq? ] unit-test
+[ t ] [ char c-type MyChar c-type eq? ] unit-test
+[ f ] [ void* c-type "MyChar*" parse-c-type c-type eq? ] unit-test
+[ t ] [ "char*" parse-c-type c-type "MyChar*" parse-c-type c-type eq? ] unit-test
-[ 32 ] [ { "int" 8 } heap-size ] unit-test
+[ 32 ] [ { int 8 } heap-size ] unit-test
TYPEDEF: char* MyString
-[ t ] [ "char*" c-type "MyString" c-type eq? ] unit-test
-[ t ] [ "void*" c-type "MyString*" c-type eq? ] unit-test
+[ t ] [ char* c-type MyString c-type eq? ] unit-test
+[ t ] [ void* c-type "MyString*" parse-c-type c-type eq? ] unit-test
TYPEDEF: int* MyIntArray
-[ t ] [ "void*" c-type "MyIntArray" c-type eq? ] unit-test
+[ t ] [ void* c-type MyIntArray c-type eq? ] unit-test
TYPEDEF: uchar* MyLPBYTE
-[ t ] [ { char* utf8 } c-type "MyLPBYTE" c-type = ] unit-test
+[ t ] [ { char* utf8 } c-type MyLPBYTE c-type = ] unit-test
[
0 B{ 1 2 3 4 } <displaced-alien> <void*>
-USING: alien.syntax kernel windows.types ;
+USING: alien.c-types alien.syntax kernel windows.types ;
IN: opengl.gl.windows
LIBRARY: gl
-USING: alien.syntax kernel math windows.types windows.kernel32
-math.bitwise classes.struct ;
+USING: alien.c-types alien.syntax kernel math windows.types
+windows.kernel32 math.bitwise classes.struct ;
IN: windows.advapi32
LIBRARY: advapi32
SE_WMIGUID_OBJECT
SE_REGISTRY_WOW64_32KEY ;
-TYPEDEF: TRUSTEE* PTRUSTEE
-
STRUCT: TRUSTEE
- { pMultipleTrustee PTRUSTEE }
+ { pMultipleTrustee TRUSTEE* }
{ MultipleTrusteeOperation MULTIPLE_TRUSTEE_OPERATION }
{ TrusteeForm TRUSTEE_FORM }
{ TrusteeType TRUSTEE_TYPE }
{ ptstrName LPTSTR } ;
+TYPEDEF: TRUSTEE* PTRUSTEE
+
STRUCT: EXPLICIT_ACCESS
{ grfAccessPermissions DWORD }
{ grfAccessMode ACCESS_MODE }
-USING: alien alien.c-types alien.destructors windows.com.syntax\r
-windows.ole32 windows.types continuations kernel alien.syntax\r
-libc destructors accessors alien.data ;\r
-IN: windows.com\r
-\r
-LIBRARY: ole32\r
-\r
-COM-INTERFACE: IUnknown f {00000000-0000-0000-C000-000000000046}\r
- HRESULT QueryInterface ( REFGUID iid, void** ppvObject )\r
- ULONG AddRef ( )\r
- ULONG Release ( ) ;\r
-\r
-COM-INTERFACE: IDataObject IUnknown {0000010E-0000-0000-C000-000000000046}\r
- HRESULT GetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium )\r
- HRESULT GetDataHere ( FORMATETC* pFormatetc, STGMEDIUM* pmedium )\r
- HRESULT QueryGetData ( FORMATETC* pFormatetc )\r
- HRESULT GetCanonicalFormatEtc ( FORMATETC* pFormatetcIn, FORMATETC* pFormatetcOut )\r
- HRESULT SetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium, BOOL fRelease )\r
- HRESULT EnumFormatEtc ( DWORD dwDirection, IEnumFORMATETC** ppenumFormatetc )\r
- HRESULT DAdvise ( FORMATETC* pFormatetc, DWORD advf, IAdviseSink* pAdvSink, DWORD* pdwConnection )\r
- HRESULT DUnadvise ( DWORD pdwConnection )\r
- HRESULT EnumDAdvise ( IEnumSTATDATA** ppenumAdvise ) ;\r
-\r
-COM-INTERFACE: IDropTarget IUnknown {00000122-0000-0000-C000-000000000046}\r
- HRESULT DragEnter ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect )\r
- HRESULT DragOver ( DWORD grfKeyState, POINTL pt, DWORD* pdwEffect )\r
- HRESULT DragLeave ( )\r
- HRESULT Drop ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect ) ;\r
-\r
-: com-query-interface ( interface iid -- interface' )\r
- [\r
- "void*" malloc-object &free\r
- [ IUnknown::QueryInterface ole32-error ] keep *void*\r
- ] with-destructors ;\r
-\r
-: com-add-ref ( interface -- interface )\r
- [ IUnknown::AddRef drop ] keep ; inline\r
-\r
-: com-release ( interface -- )\r
- IUnknown::Release drop ; inline\r
-\r
-: with-com-interface ( interface quot -- )\r
- over [ com-release ] curry [ ] cleanup ; inline\r
-\r
-DESTRUCTOR: com-release\r
+USING: alien alien.c-types alien.destructors windows.com.syntax
+windows.ole32 windows.types continuations kernel alien.syntax
+libc destructors accessors alien.data ;
+IN: windows.com
+
+LIBRARY: ole32
+
+COM-INTERFACE: IUnknown f {00000000-0000-0000-C000-000000000046}
+ HRESULT QueryInterface ( REFGUID iid, void** ppvObject )
+ ULONG AddRef ( )
+ ULONG Release ( ) ;
+
+TYPEDEF: void* IAdviseSink*
+
+COM-INTERFACE: IDataObject IUnknown {0000010E-0000-0000-C000-000000000046}
+ HRESULT GetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium )
+ HRESULT GetDataHere ( FORMATETC* pFormatetc, STGMEDIUM* pmedium )
+ HRESULT QueryGetData ( FORMATETC* pFormatetc )
+ HRESULT GetCanonicalFormatEtc ( FORMATETC* pFormatetcIn, FORMATETC* pFormatetcOut )
+ HRESULT SetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium, BOOL fRelease )
+ HRESULT EnumFormatEtc ( DWORD dwDirection, IEnumFORMATETC** ppenumFormatetc )
+ HRESULT DAdvise ( FORMATETC* pFormatetc, DWORD advf, IAdviseSink* pAdvSink, DWORD* pdwConnection )
+ HRESULT DUnadvise ( DWORD pdwConnection )
+ HRESULT EnumDAdvise ( IEnumSTATDATA** ppenumAdvise ) ;
+
+COM-INTERFACE: IDropTarget IUnknown {00000122-0000-0000-C000-000000000046}
+ HRESULT DragEnter ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect )
+ HRESULT DragOver ( DWORD grfKeyState, POINTL pt, DWORD* pdwEffect )
+ HRESULT DragLeave ( )
+ HRESULT Drop ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect ) ;
+
+FUNCTION: HRESULT RegisterDragDrop ( HWND hWnd, IDropTarget* pDropTarget ) ;
+FUNCTION: HRESULT RevokeDragDrop ( HWND hWnd ) ;
+FUNCTION: void ReleaseStgMedium ( LPSTGMEDIUM pmedium ) ;
+
+: com-query-interface ( interface iid -- interface' )
+ [
+ "void*" malloc-object &free
+ [ IUnknown::QueryInterface ole32-error ] keep *void*
+ ] with-destructors ;
+
+: com-add-ref ( interface -- interface )
+ [ IUnknown::AddRef drop ] keep ; inline
+
+: com-release ( interface -- )
+ IUnknown::Release drop ; inline
+
+: with-com-interface ( interface quot -- )
+ over [ com-release ] curry [ ] cleanup ; inline
+
+DESTRUCTOR: com-release
-USING: alien alien.c-types alien.accessors effects kernel
-windows.ole32 parser lexer splitting grouping sequences
-namespaces assocs quotations generalizations accessors words
-macros alien.syntax fry arrays layouts math classes.struct
-windows.kernel32 ;
+USING: alien alien.c-types alien.accessors alien.parser
+effects kernel windows.ole32 parser lexer splitting grouping
+sequences namespaces assocs quotations generalizations
+accessors words macros alien.syntax fry arrays layouts math
+classes.struct windows.kernel32 ;
IN: windows.com.syntax
<PRIVATE
"stdcall" alien-indirect
] ;
-TUPLE: com-interface-definition name parent iid functions ;
+TUPLE: com-interface-definition word parent iid functions ;
C: <com-interface-definition> com-interface-definition
TUPLE: com-function-definition name return parameters ;
[ H{ } +com-interface-definitions+ set-global ]
unless
+ERROR: no-com-interface interface ;
+
: find-com-interface-definition ( name -- definition )
- dup "f" = [ drop f ] [
+ [
dup +com-interface-definitions+ get-global at*
- [ nip ]
- [ " COM interface hasn't been defined" prepend throw ]
- if
- ] if ;
+ [ nip ] [ drop no-com-interface ] if
+ ] [ f ] if* ;
: save-com-interface-definition ( definition -- )
- dup name>> +com-interface-definitions+ get-global set-at ;
+ dup word>> +com-interface-definitions+ get-global set-at ;
: (parse-com-function) ( tokens -- definition )
[ second ]
[ first ]
- [ 3 tail [ CHAR: , swap remove ] map 2 group { "void*" "this" } prefix ]
- tri
+ [
+ 3 tail [ CHAR: , swap remove ] map
+ 2 group [ first2 normalize-c-arg 2array ] map
+ { void* "this" } prefix
+ ] tri
<com-function-definition> ;
: parse-com-functions ( -- functions )
[ (parse-com-function) ] map ;
: (iid-word) ( definition -- word )
- name>> "-iid" append create-in ;
+ word>> name>> "-iid" append create-in ;
: (function-word) ( function interface -- word )
- name>> "::" rot name>> 3append create-in ;
+ swap [ word>> name>> "::" ] [ name>> ] bi*
+ 3append create-in ;
: family-tree ( definition -- definitions )
dup parent>> [ family-tree ] [ { } ] if*
: define-words-for-com-interface ( definition -- )
[ [ (iid-word) ] [ iid>> 1quotation ] bi (( -- iid )) define-declared ]
- [ name>> "com-interface" swap typedef ]
+ [ word>> void* swap typedef ]
[
dup family-tree-functions
[ (define-word-for-function) ] with each-index
PRIVATE>
SYNTAX: COM-INTERFACE:
- scan
- scan find-com-interface-definition
+ CREATE-C-TYPE
+ scan-object find-com-interface-definition
scan string>guid
parse-com-functions
<com-interface-definition>
USING: windows.kernel32 windows.ole32 windows.com windows.com.syntax
alien alien.c-types alien.syntax kernel system namespaces math
-classes.struct ;
+classes.struct windows.types ;
IN: windows.dinput
LIBRARY: dinput
! Copyright (C) 2005, 2006 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax alien.destructors kernel windows.types
-math.bitwise ;
+USING: alien alien.c-types alien.syntax alien.destructors
+kernel windows.types math.bitwise ;
IN: windows.gdi32
CONSTANT: BI_RGB 0
! Copyright (C) 2005, 2006 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax kernel windows.types multiline
-classes.struct ;
+USING: alien alien.c-types alien.syntax kernel windows.types
+multiline classes.struct ;
IN: windows.kernel32
CONSTANT: MAX_PATH 260
TYPEDEF: DCB* PDCB
TYPEDEF: DCB* LPDCB
-STRUCT: COMM_CONFIG
+STRUCT: COMMCONFIG
{ dwSize DWORD }
{ wVersion WORD }
{ wReserved WORD }
FUNCTION: HRESULT OleInitialize ( void* reserved ) ;
FUNCTION: HRESULT CoInitializeEx ( void* reserved, DWORD dwCoInit ) ;
-FUNCTION: HRESULT RegisterDragDrop ( HWND hWnd, IDropTarget* pDropTarget ) ;
-FUNCTION: HRESULT RevokeDragDrop ( HWND hWnd ) ;
-FUNCTION: void ReleaseStgMedium ( LPSTGMEDIUM pmedium ) ;
-
: succeeded? ( hresult -- ? )
0 HEX: 7FFFFFFF between? ;
USING: alien alien.c-types alien.strings alien.syntax
classes.struct combinators io.encodings.utf16n io.files
io.pathnames kernel windows.errors windows.com
-windows.com.syntax windows.user32 windows.ole32 windows
-specialized-arrays ;
+windows.com.syntax windows.types windows.user32
+windows.ole32 windows specialized-arrays ;
SPECIALIZED-ARRAY: ushort
IN: windows.shell32
TYPEDEF: int INT32
TYPEDEF: uint UINT32
TYPEDEF: uint DWORD32
+TYPEDEF: long LONG32
TYPEDEF: ulong ULONG32
TYPEDEF: ulonglong ULONG64
TYPEDEF: long* POINTER_32
TYPEDEF: ulonglong ULARGE_INTEGER
TYPEDEF: LARGE_INTEGER* PLARGE_INTEGER
TYPEDEF: ULARGE_INTEGER* PULARGE_INTEGER
+TYPEDEF: size_t SIZE_T
+TYPEDEF: ptrdiff_t SSIZE_T
TYPEDEF: wchar_t* LPCSTR
TYPEDEF: wchar_t* LPWSTR
TYPEDEF: LONGLONG USN
TYPEDEF: UINT_PTR WPARAM
-TYPEDEF: RECT* LPRECT
-TYPEDEF: void* PWNDCLASS
-TYPEDEF: void* PWNDCLASSEX
-TYPEDEF: void* LPWNDCLASS
-TYPEDEF: void* LPWNDCLASSEX
-TYPEDEF: void* MSGBOXPARAMSA
-TYPEDEF: void* MSGBOXPARAMSW
-TYPEDEF: void* LPOVERLAPPED_COMPLETION_ROUTINE
-
TYPEDEF: size_t socklen_t
TYPEDEF: void* WNDPROC
TYPEDEF: HANDLE HGLRC
TYPEDEF: HANDLE HRGN
+TYPEDEF: void* PWNDCLASS
+TYPEDEF: void* PWNDCLASSEX
+TYPEDEF: void* LPWNDCLASS
+TYPEDEF: void* LPWNDCLASSEX
+TYPEDEF: void* MSGBOXPARAMSA
+TYPEDEF: void* MSGBOXPARAMSW
+TYPEDEF: void* LPOVERLAPPED_COMPLETION_ROUTINE
+
STRUCT: LVITEM
{ mask uint }
{ iItem int }
! Copyright (C) 2005, 2006 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax parser namespaces kernel math
-windows.types generalizations math.bitwise classes.struct
-literals ;
+USING: alien alien.c-types alien.syntax parser namespaces
+kernel math windows.types generalizations math.bitwise
+classes.struct literals windows.kernel32 ;
IN: windows.user32
! HKL for ActivateKeyboardLayout
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax alien.destructors classes.struct ;
+USING: alien.c-types alien.syntax alien.destructors classes.struct
+windows.types ;
IN: windows.usp10
LIBRARY: usp10
STRUCT: SCRIPT_VISATTR
{ flags WORD } ;
+TYPEDEF: void* SCRIPT_CACHE*
+TYPEDEF: void* ABC*
+
FUNCTION: HRESULT ScriptShape (
HDC hdc,
SCRIPT_CACHE* psc,
CONSTANT: SOL_SOCKET HEX: ffff
+TYPEDEF: void* sockaddr*
+
STRUCT: sockaddr-in
{ family short }
{ port ushort }
{ sec long }
{ usec long } ;
+TYPEDEF: void* fd_set*
+
LIBRARY: winsock
FUNCTION: int setsockopt ( SOCKET s, int level, int optname, char* 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 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,
FUNCTION: hostent* gethostbyname ( char* name ) ;
FUNCTION: int gethostname ( char* name, int len ) ;
-FUNCTION: int connect ( void* socket, sockaddr_in* sockaddr, int addrlen ) ;
+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 getsockname ( SOCKET s, sockaddr_in* address, int* addrlen ) ;
-FUNCTION: int getpeername ( SOCKET s, sockaddr_in* address, int* addrlen ) ;
+FUNCTION: int getsockname ( SOCKET s, sockaddr-in* address, int* addrlen ) ;
+FUNCTION: int getpeername ( SOCKET s, sockaddr-in* address, int* addrlen ) ;
TYPEDEF: uint SERVICETYPE
TYPEDEF: OVERLAPPED WSAOVERLAPPED
projects / factor.git / commitdiff