new vocab windows.streams: COM IStream wrapper for factor streams

db4
Joe Groff 2010-06-28 21:51:49 -07:00
parent 6bca9f2e15
commit 780c190d69
4 changed files with 123 additions and 1 deletions

View File

@ -48,6 +48,12 @@ STRUCT: STATSTG
{ grfStateBits DWORD }
{ reserved DWORD } ;
CONSTANT: STGM_READ 0
CONSTANT: STGM_WRITE 1
CONSTANT: STGM_READWRITE 2
CONSTANT: STG_E_INVALIDFUNCTION HEX: 80030001
CONSTANT: STGTY_STORAGE 1
CONSTANT: STGTY_STREAM 2
CONSTANT: STGTY_LOCKBYTES 3
@ -61,10 +67,12 @@ CONSTANT: LOCK_WRITE 1
CONSTANT: LOCK_EXCLUSIVE 2
CONSTANT: LOCK_ONLYONCE 4
CONSTANT: GUID_NULL GUID: {00000000-0000-0000-0000-000000000000}
COM-INTERFACE: IStream ISequentialStream {0000000C-0000-0000-C000-000000000046}
HRESULT Seek ( LARGE_INTEGER dlibMove, DWORD dwOrigin, ULARGE_INTEGER* plibNewPosition )
HRESULT SetSize ( ULARGE_INTEGER* libNewSize )
HRESULT CopyTo ( IStream* pstm, ULARGE_INTEGER* cb, ULARGE_INTEGER* pcbRead, ULARGE_INTEGER* pcbWritten )
HRESULT CopyTo ( IStream* pstm, ULARGE_INTEGER cb, ULARGE_INTEGER* pcbRead, ULARGE_INTEGER* pcbWritten )
HRESULT Commit ( DWORD grfCommitFlags )
HRESULT Revert ( )
HRESULT LockRegion ( ULARGE_INTEGER libOffset, ULARGE_INTEGER cb, DWORD dwLockType )

View File

@ -0,0 +1 @@
windows

View File

@ -0,0 +1,112 @@
USING: accessors alien.c-types classes.struct combinators
continuations io kernel libc literals locals sequences
specialized-arrays windows.com memoize
windows.com.wrapper windows.kernel32 windows.ole32
windows.types ;
IN: windows.streams
SPECIALIZED-ARRAY: uchar
<PRIVATE
: with-hresult ( quot: ( -- result ) -- result )
[ drop E_FAIL ] recover ; inline
:: IStream-read ( stream pv cb out-read -- hresult )
[
cb stream stream-read :> buf
buf length :> bytes
pv buf bytes memcpy
out-read [ bytes out-read 0 ULONG set-alien-value ] when
cb bytes = [ S_OK ] [ S_FALSE ] if
] with-hresult ; inline
:: IStream-write ( stream pv cb out-written -- hresult )
[
pv cb <direct-uchar-array> stream stream-write
out-written [ cb out-written 0 ULONG set-alien-value ] when
S_OK
] with-hresult ; inline
: origin>seek-type ( origin -- seek-type )
{
{ $ STREAM_SEEK_SET [ seek-absolute ] }
{ $ STREAM_SEEK_CUR [ seek-relative ] }
{ $ STREAM_SEEK_END [ seek-end ] }
} case ;
:: IStream-seek ( stream move origin new-position -- hresult )
[
move origin origin>seek-type stream stream-seek
new-position [
stream stream-tell new-position 0 ULARGE_INTEGER set-alien-value
] when
S_OK
] with-hresult ; inline
:: IStream-set-size ( stream new-size -- hresult )
STG_E_INVALIDFUNCTION ;
:: IStream-copy-to ( stream other-stream cb out-read out-written -- hresult )
[
cb stream stream-read :> buf
buf length :> bytes
out-read [ bytes out-read 0 ULONG set-alien-value ] when
other-stream buf bytes out-written IStream::Write
] with-hresult ; inline
:: IStream-commit ( stream flags -- hresult )
stream stream-flush S_OK ;
:: IStream-revert ( stream -- hresult )
STG_E_INVALIDFUNCTION ;
:: IStream-lock-region ( stream offset cb lock-type -- hresult )
STG_E_INVALIDFUNCTION ;
:: IStream-unlock-region ( stream offset cb lock-type -- hresult )
STG_E_INVALIDFUNCTION ;
:: IStream-stat ( stream out-stat stat-flag -- hresult )
[
out-stat
f >>pwcsName
STGTY_STREAM >>type
0 >>cbSize
FILETIME <struct> >>mtime
FILETIME <struct> >>ctime
FILETIME <struct> >>atime
STGM_READWRITE >>grfMode
0 >>grfLocksSupported
GUID_NULL >>clsid
0 >>grfStateBits
0 >>reserved
] with-hresult ;
:: IStream-clone ( out-clone-stream -- hresult )
f out-clone-stream 0 void* set-alien-value
STG_E_INVALIDFUNCTION ;
MEMO: stream-wrapper ( -- wrapper )
{
{ IStream {
[ IStream-read ]
[ IStream-write ]
[ IStream-seek ]
[ IStream-set-size ]
[ IStream-copy-to ]
[ IStream-commit ]
[ IStream-revert ]
[ IStream-lock-region ]
[ IStream-unlock-region ]
[ IStream-stat ]
[ IStream-clone ]
} }
} <com-wrapper> ;
PRIVATE>
: stream>IStream ( stream -- IStream )
stream-wrapper com-wrap ;

View File

@ -0,0 +1 @@
IStream interface wrapper for Factor stream objects