1 USING: accessors alien.c-types alien.data classes.struct
2 combinators continuations io kernel libc literals locals
3 sequences specialized-arrays windows.com memoize
4 windows.com.wrapper windows.kernel32 windows.ole32
8 SPECIALIZED-ARRAY: uchar
12 : with-hresult ( quot: ( -- result ) -- result )
13 [ drop E_FAIL ] recover ; inline
15 :: IStream-read ( stream pv cb out-read -- hresult )
17 cb stream stream-read :> buf
20 out-read [ bytes out-read 0 ULONG set-alien-value ] when
22 cb bytes = [ S_OK ] [ S_FALSE ] if
23 ] with-hresult ; inline
25 :: IStream-write ( stream pv cb out-written -- hresult )
27 pv cb uchar <c-direct-array> stream stream-write
28 out-written [ cb out-written 0 ULONG set-alien-value ] when
30 ] with-hresult ; inline
32 : origin>seek-type ( origin -- seek-type )
34 { $ STREAM_SEEK_SET [ seek-absolute ] }
35 { $ STREAM_SEEK_CUR [ seek-relative ] }
36 { $ STREAM_SEEK_END [ seek-end ] }
39 :: IStream-seek ( stream move origin new-position -- hresult )
41 move origin origin>seek-type stream stream-seek
43 stream stream-tell new-position 0 ULARGE_INTEGER set-alien-value
46 ] with-hresult ; inline
48 :: IStream-set-size ( stream new-size -- hresult )
49 STG_E_INVALIDFUNCTION ;
51 :: IStream-copy-to ( stream other-stream cb out-read out-written -- hresult )
53 cb stream stream-read :> buf
55 out-read [ bytes out-read 0 ULONG set-alien-value ] when
57 other-stream buf bytes out-written IStream::Write
58 ] with-hresult ; inline
60 :: IStream-commit ( stream flags -- hresult )
61 stream stream-flush S_OK ;
63 :: IStream-revert ( stream -- hresult )
64 STG_E_INVALIDFUNCTION ;
66 :: IStream-lock-region ( stream offset cb lock-type -- hresult )
67 STG_E_INVALIDFUNCTION ;
69 :: IStream-unlock-region ( stream offset cb lock-type -- hresult )
70 STG_E_INVALIDFUNCTION ;
72 :: stream-size ( stream -- size )
73 stream stream-tell :> old-pos
74 0 seek-end stream stream-seek
75 stream stream-tell :> size
76 old-pos seek-absolute stream stream-seek
79 :: IStream-stat ( stream out-stat stat-flag -- hresult )
84 stream stream-size >>cbSize
88 STGM_READWRITE >>grfMode
97 :: IStream-clone ( stream out-clone-stream -- hresult )
98 f out-clone-stream 0 void* set-alien-value
99 STG_E_INVALIDFUNCTION ;
101 CONSTANT: stream-wrapper
112 [ IStream-lock-region ]
113 [ IStream-unlock-region ]
122 : stream>IStream ( stream -- IStream )
123 stream-wrapper com-wrap ;