steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

update windows vocabs to load without c-type strings

db4
Joe Groff 2009-09-27 18:19:53 -05:00
parent 20621bbbb6
commit 4f82861bf3
11 changed files with 106 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/opengl/gl/windows/windows.factor Normal file → Executable file
View File

@ -1,4 +1,4 @@
USING: alien.syntax kernel windows.types ;
USING: alien.c-types alien.syntax kernel windows.types ;
IN: opengl.gl.windows
LIBRARY: gl

10
basis/windows/advapi32/advapi32.factor
View File

@ -1,5 +1,5 @@
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
@ -222,15 +222,15 @@ C-ENUM:
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 }

96
basis/windows/com/com.factor Normal file → Executable file
View File

@ -1,45 +1,51 @@
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 ( ) ;
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 ) ;
: 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.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

42
basis/windows/com/syntax/syntax.factor
View File

@ -1,8 +1,8 @@
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
@ -14,7 +14,7 @@ MACRO: com-invoke ( n return parameters -- )
"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 ;
@ -25,22 +25,25 @@ SYMBOL: +com-interface-definitions+
[ 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 )
@ -48,10 +51,11 @@ unless
[ (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*
@ -79,7 +83,7 @@ unless
: 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
@ -89,8 +93,8 @@ unless
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>

4
basis/windows/gdi32/gdi32.factor
View File

@ -1,7 +1,7 @@
! 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

6
basis/windows/kernel32/kernel32.factor
View File

@ -1,7 +1,7 @@
! 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
@ -543,7 +543,7 @@ STRUCT: DCB
TYPEDEF: DCB* PDCB
TYPEDEF: DCB* LPDCB
STRUCT: COMM_CONFIG
STRUCT: COMMCONFIG
{ dwSize DWORD }
{ wVersion WORD }
{ wReserved WORD }

4
basis/windows/ole32/ole32.factor
View File

@ -111,10 +111,6 @@ CONSTANT: COINIT_SPEED_OVER_MEMORY 8
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? ;

4
basis/windows/shell32/shell32.factor Normal file → Executable file
View File

@ -3,8 +3,8 @@
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

20
basis/windows/types/types.factor
View File

@ -61,6 +61,7 @@ TYPEDEF: ulong ULONG_PTR
TYPEDEF: int INT32
TYPEDEF: uint UINT32
TYPEDEF: uint DWORD32
TYPEDEF: long LONG32
TYPEDEF: ulong ULONG32
TYPEDEF: ulonglong ULONG64
TYPEDEF: long* POINTER_32
@ -75,6 +76,8 @@ TYPEDEF: longlong LARGE_INTEGER
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
@ -201,15 +204,6 @@ TYPEDEF: LONG_PTR SSIZE_T
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
@ -343,6 +337,14 @@ TYPEDEF: PFD* LPPFD
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 }

6
basis/windows/user32/user32.factor
View File

@ -1,8 +1,8 @@
! 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

6
basis/windows/usp10/usp10.factor
View File

@ -1,6 +1,7 @@
! 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
@ -56,6 +57,9 @@ SCRIPT_JUSTIFFY_RESERVED4 ;
STRUCT: SCRIPT_VISATTR
{ flags WORD } ;
TYPEDEF: void* SCRIPT_CACHE*
TYPEDEF: void* ABC*
FUNCTION: HRESULT ScriptShape (
HDC hdc,
SCRIPT_CACHE* psc,