new vocab windows.streams: COM IStream wrapper for factor streams
parent
6bca9f2e15
commit
780c190d69
|
@ -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 )
|
||||
|
|
|
@ -0,0 +1 @@
|
|||
windows
|
|
@ -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 ;
|
|
@ -0,0 +1 @@
|
|||
IStream interface wrapper for Factor stream objects
|
Loading…
Reference in New Issue