USING: alien alien.syntax alien.c-types alien.strings math
-kernel sequences windows windows.types debugger io accessors
-math.order namespaces make math.parser windows.kernel32
-combinators ;
+kernel sequences windows.errors windows.types io
+accessors math.order namespaces make math.parser windows.kernel32
+combinators locals specialized-arrays.direct.uchar
+literals splitting grouping classes.struct combinators.smart ;
IN: windows.ole32
LIBRARY: ole32
FUNCTION: int StringFromGUID2 ( REFGUID rguid, LPOLESTR lpsz, int cchMax ) ;
FUNCTION: HRESULT CLSIDFromString ( LPOLESTR lpsz, REFGUID out_rguid ) ;
-: S_OK 0 ; inline
-: S_FALSE 1 ; inline
-: E_NOINTERFACE HEX: 80004002 ; inline
-: E_FAIL HEX: 80004005 ; inline
-: E_INVALIDARG HEX: 80070057 ; inline
-
-: MK_ALT HEX: 20 ; inline
-: DROPEFFECT_NONE 0 ; inline
-: DROPEFFECT_COPY 1 ; inline
-: DROPEFFECT_MOVE 2 ; inline
-: DROPEFFECT_LINK 4 ; inline
-: DROPEFFECT_SCROLL HEX: 80000000 ; inline
-: DD_DEFSCROLLINSET 11 ; inline
-: DD_DEFSCROLLDELAY 50 ; inline
-: DD_DEFSCROLLINTERVAL 50 ; inline
-: DD_DEFDRAGDELAY 200 ; inline
-: DD_DEFDRAGMINDIST 2 ; inline
-
-: CF_TEXT 1 ; inline
-: CF_BITMAP 2 ; inline
-: CF_METAFILEPICT 3 ; inline
-: CF_SYLK 4 ; inline
-: CF_DIF 5 ; inline
-: CF_TIFF 6 ; inline
-: CF_OEMTEXT 7 ; inline
-: CF_DIB 8 ; inline
-: CF_PALETTE 9 ; inline
-: CF_PENDATA 10 ; inline
-: CF_RIFF 11 ; inline
-: CF_WAVE 12 ; inline
-: CF_UNICODETEXT 13 ; inline
-: CF_ENHMETAFILE 14 ; inline
-: CF_HDROP 15 ; inline
-: CF_LOCALE 16 ; inline
-: CF_MAX 17 ; inline
-
-: CF_OWNERDISPLAY HEX: 0080 ; inline
-: CF_DSPTEXT HEX: 0081 ; inline
-: CF_DSPBITMAP HEX: 0082 ; inline
-: CF_DSPMETAFILEPICT HEX: 0083 ; inline
-: CF_DSPENHMETAFILE HEX: 008E ; inline
-
-: DVASPECT_CONTENT 1 ; inline
-: DVASPECT_THUMBNAIL 2 ; inline
-: DVASPECT_ICON 4 ; inline
-: DVASPECT_DOCPRINT 8 ; inline
-
-: TYMED_HGLOBAL 1 ; inline
-: TYMED_FILE 2 ; inline
-: TYMED_ISTREAM 4 ; inline
-: TYMED_ISTORAGE 8 ; inline
-: TYMED_GDI 16 ; inline
-: TYMED_MFPICT 32 ; inline
-: TYMED_ENHMF 64 ; inline
-: TYMED_NULL 0 ; inline
+CONSTANT: S_OK 0
+CONSTANT: S_FALSE 1
+CONSTANT: E_NOINTERFACE HEX: 80004002
+CONSTANT: E_FAIL HEX: 80004005
+CONSTANT: E_INVALIDARG HEX: 80070057
+
+CONSTANT: MK_ALT HEX: 20
+CONSTANT: DROPEFFECT_NONE 0
+CONSTANT: DROPEFFECT_COPY 1
+CONSTANT: DROPEFFECT_MOVE 2
+CONSTANT: DROPEFFECT_LINK 4
+CONSTANT: DROPEFFECT_SCROLL HEX: 80000000
+CONSTANT: DD_DEFSCROLLINSET 11
+CONSTANT: DD_DEFSCROLLDELAY 50
+CONSTANT: DD_DEFSCROLLINTERVAL 50
+CONSTANT: DD_DEFDRAGDELAY 200
+CONSTANT: DD_DEFDRAGMINDIST 2
+
+CONSTANT: CF_TEXT 1
+CONSTANT: CF_BITMAP 2
+CONSTANT: CF_METAFILEPICT 3
+CONSTANT: CF_SYLK 4
+CONSTANT: CF_DIF 5
+CONSTANT: CF_TIFF 6
+CONSTANT: CF_OEMTEXT 7
+CONSTANT: CF_DIB 8
+CONSTANT: CF_PALETTE 9
+CONSTANT: CF_PENDATA 10
+CONSTANT: CF_RIFF 11
+CONSTANT: CF_WAVE 12
+CONSTANT: CF_UNICODETEXT 13
+CONSTANT: CF_ENHMETAFILE 14
+CONSTANT: CF_HDROP 15
+CONSTANT: CF_LOCALE 16
+CONSTANT: CF_MAX 17
+
+CONSTANT: CF_OWNERDISPLAY HEX: 0080
+CONSTANT: CF_DSPTEXT HEX: 0081
+CONSTANT: CF_DSPBITMAP HEX: 0082
+CONSTANT: CF_DSPMETAFILEPICT HEX: 0083
+CONSTANT: CF_DSPENHMETAFILE HEX: 008E
+
+CONSTANT: DVASPECT_CONTENT 1
+CONSTANT: DVASPECT_THUMBNAIL 2
+CONSTANT: DVASPECT_ICON 4
+CONSTANT: DVASPECT_DOCPRINT 8
+
+CONSTANT: TYMED_HGLOBAL 1
+CONSTANT: TYMED_FILE 2
+CONSTANT: TYMED_ISTREAM 4
+CONSTANT: TYMED_ISTORAGE 8
+CONSTANT: TYMED_GDI 16
+CONSTANT: TYMED_MFPICT 32
+CONSTANT: TYMED_ENHMF 64
+CONSTANT: TYMED_NULL 0
C-STRUCT: DVTARGETDEVICE
{ "DWORD" "tdSize" }
{ "LPUNKNOWN" "punkForRelease" } ;
TYPEDEF: STGMEDIUM* LPSTGMEDIUM
-: COINIT_MULTITHREADED 0 ; inline
-: COINIT_APARTMENTTHREADED 2 ; inline
-: COINIT_DISABLE_OLE1DDE 4 ; inline
-: COINIT_SPEED_OVER_MEMORY 8 ; inline
+CONSTANT: COINIT_MULTITHREADED 0
+CONSTANT: COINIT_APARTMENTTHREADED 2
+CONSTANT: COINIT_DISABLE_OLE1DDE 4
+CONSTANT: COINIT_SPEED_OVER_MEMORY 8
FUNCTION: HRESULT OleInitialize ( void* reserved ) ;
FUNCTION: HRESULT CoInitializeEx ( void* reserved, DWORD dwCoInit ) ;
: succeeded? ( hresult -- ? )
0 HEX: 7FFFFFFF between? ;
-TUPLE: ole32-error error-code ;
-C: <ole32-error> ole32-error
+TUPLE: ole32-error code message ;
-M: ole32-error error.
- "COM method failed: " print error-code>> (win32-error-string) print ;
+: <ole32-error> ( code -- error )
+ dup n>win32-error-string \ ole32-error boa ;
: ole32-error ( hresult -- )
dup succeeded? [ drop ] [ <ole32-error> throw ] if ;
: guid= ( a b -- ? )
[ 16 memory>byte-array ] bi@ = ;
-: GUID-STRING-LENGTH
- "{01234567-89ab-cdef-0123-456789abcdef}" length ; inline
-
-: (guid-section>guid) ( guid string start end quot -- )
- [ roll subseq hex> swap ] dip call ; inline
-: (guid-byte>guid) ( guid string start end byte -- )
- [ roll subseq hex> ] dip
- rot GUID-Data4 set-uchar-nth ; inline
+CONSTANT: GUID-STRING-LENGTH
+ $[ "{01234567-89ab-cdef-0123-456789abcdef}" length ]
: string>guid ( string -- guid )
- "GUID" <c-object> [ {
- [ 1 9 [ set-GUID-Data1 ] (guid-section>guid) ]
-
- [ 10 14 [ set-GUID-Data2 ] (guid-section>guid) ]
-
- [ 15 19 [ set-GUID-Data3 ] (guid-section>guid) ]
-
- [ 20 22 0 (guid-byte>guid) ]
- [ 22 24 1 (guid-byte>guid) ]
-
- [ 25 27 2 (guid-byte>guid) ]
- [ 27 29 3 (guid-byte>guid) ]
- [ 29 31 4 (guid-byte>guid) ]
- [ 31 33 5 (guid-byte>guid) ]
- [ 33 35 6 (guid-byte>guid) ]
- [ 35 37 7 (guid-byte>guid) ]
- } 2cleave ] keep ;
-
-: (guid-section%) ( guid quot len -- )
- [ call >hex ] dip CHAR: 0 pad-left % ; inline
-: (guid-byte%) ( guid byte -- )
- swap GUID-Data4 uchar-nth >hex 2
- CHAR: 0 pad-left % ; inline
+ "{-}" split harvest
+ [ first3 [ hex> ] tri@ ]
+ [ 3 tail concat 2 group [ hex> ] B{ } map-as ] bi
+ GUID <struct-boa> ;
: guid>string ( guid -- string )
- [ "{" % {
- [ [ GUID-Data1 ] 8 (guid-section%) "-" % ]
- [ [ GUID-Data2 ] 4 (guid-section%) "-" % ]
- [ [ GUID-Data3 ] 4 (guid-section%) "-" % ]
- [ 0 (guid-byte%) ]
- [ 1 (guid-byte%) "-" % ]
- [ 2 (guid-byte%) ]
- [ 3 (guid-byte%) ]
- [ 4 (guid-byte%) ]
- [ 5 (guid-byte%) ]
- [ 6 (guid-byte%) ]
- [ 7 (guid-byte%) "}" % ]
- } cleave ] "" make ;
-
+ [
+ [ "{" ] dip {
+ [ Data1>> >hex "-" ]
+ [ Data2>> >hex "-" ]
+ [ Data3>> >hex "-" ]
+ [
+ Data4>> [
+ {
+ [ >hex 2 CHAR: 0 pad-head ]
+ [ >hex 2 CHAR: 0 pad-head "-" ]
+ [ >hex 2 CHAR: 0 pad-head ]
+ [ >hex 2 CHAR: 0 pad-head ]
+ [ >hex 2 CHAR: 0 pad-head ]
+ [ >hex 2 CHAR: 0 pad-head ]
+ [ >hex 2 CHAR: 0 pad-head ]
+ [ >hex 2 CHAR: 0 pad-head ]
+ } spread
+ ] input<sequence "}"
+ ]
+ } cleave
+ ] "" append-outputs-as ;
projects / factor.git / blobdiff