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