DEADSOFTWARE

fixed sky preview and selection
[d2df-editor.git] / src / shared / xstreams.pas
1 (* Copyright (C) Doom 2D: Forever Developers
2 *
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
6 * (at your option) any later version.
7 *
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
12 *
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 *)
16 // special stream classes
17 {$INCLUDE a_modes.inc}
18 {.$R+}
19 unit xstreams;
21 interface
23 uses
24 SysUtils, Classes,
25 zbase{z_stream};
28 type
29 XStreamError = class(Exception);
31 // read-only ïîòîê äëÿ èçâëå÷åíèÿ èç èñõîäíîãî òîëüêî êóñî÷êà
32 TSFSPartialStream = class(TStream)
33 protected
34 fSource: TStream; // èñõîäíûé ïîòîê
35 fKillSource: Boolean; // óáèâàòü èñõîäíèê ïðè ïîìèðàíèè?
36 fLastReadPos: Int64; // ïîñëåäíèé Read() îñòàíîâèëñÿ çäåñü (îòíîñ. fStartPos)
37 fCurrentPos: Int64; // ïîñëåäíèé Seek() îñòàíîâèëñÿ çäåñü (îòíîñ. fStartPos)
38 fStartPos: Int64; // íà÷àëî êóñî÷êà
39 fSize: Int64; // äëèíà êóñî÷êà
40 fPreBuf: packed array of Byte; // ýòîò áóôåð áóäåò ïåðåä ôàéëîì
42 procedure CheckPos ();
44 public
45 // aSrc: ïîòîê-èñõîäíèê.
46 // aPos: íà÷àëüíàÿ ïîçèöèÿ â ïîòîêå. -1 -- ñ òåêóùåé.
47 // åñëè aPos < òåêóùåé ïîçèöèè, òî èñõîäíûé ïîòîê äîëæåí
48 // íîðìàëüíî ïîääåðæèâàòü Seek()!
49 // aSize: êîëè÷åñòâî áàéòèêîâ, êîòîðîå ìîæíî ïðî÷åñòü èç ïîòîêà.
50 // åñëè ìåíüøå íóëÿ -- òî äî êîíöà.
51 // aKillSrc: óáèâàòü ëè èñõîäíûé ïîòîê, êîãäà ñàìè óìèðàåì?
52 // òàêæå ìîæåò ïðèøïàíäîðèòü ê íà÷àëó ôàéëà áóôåð. bufSz áóäåò äîáàâëåíî ê
53 // äëèíå ôàéëà.
54 constructor Create (aSrc: TStream; aPos, aSize: Int64; aKillSrc: Boolean; preBuf: Pointer=nil; bufSz: Integer=0);
55 destructor Destroy (); override;
57 // íîðìàëèçóåò count è ÷èòàåò.
58 function Read (var buffer; count: LongInt): LongInt; override;
59 // Write() ïðîñòî ãðîìêî ïàäàåò.
60 function Write (const buffer; count: LongInt): LongInt; override;
61 // Seek() ðåàëèçîâàíî, ÷òîáû ìîãëà ðàáîòàòü ïðîïåðòÿ Size.
62 // âîîáùå-òî ìîæíî ïåðåêðûòü ìåòîä GetSize(), íî âäðóã êàêîé
63 // áîëüíîé íà ãîëîâó êîäåð áóäåò ïîëó÷àòü ðàçìåð ïðè ïîìîùè
64 // Seek()'à?
65 function Seek (const offset: Int64; origin: TSeekOrigin): Int64; override;
66 end;
68 // this stream can kill both `proxied` and `guarded` streams on closing
69 TSFSGuardStream = class(TStream)
70 protected
71 fSource: TStream; // èñõîäíûé ïîòîê
72 fGuardedStream: TStream; // ïîòîê, êîòîðûé çàâàëèì ïðè ïîìèðàíèè
73 fKillSource: Boolean; // óáèâàòü èñõîäíèê ïðè ïîìèðàíèè?
74 fKillGuarded: Boolean; // óáèâàòü îõðàíÿåìûé ïðè ïîìèðàíèè?
75 fGuardedFirst: Boolean; // ïðè ñìåðòè ïåðâûì ïðèøèáàåì îõðàíÿåìîãî?
77 public
78 // aSrc: ïîòîê-èñõîäíèê (íà êîòîðûé çàìàïåíû îïåðàöèè ÷òåíèÿ/çàïèñè).
79 // aKillSrc: óáèâàòü ëè èñõîäíûé ïîòîê, êîãäà ñàìè óìèðàåì?
80 // aKillGuarded: óáèâàòü ëè îõðàíÿåìûé ïîòîê, êîãäà ñàìè óìèðàåì?
81 // aGuardedFirst: true: ïðè ñìåðòè ïåðâûì ïðèøèáàåì îõðàíÿåìîãî.
82 constructor Create (aSrc, aGuarded: TStream; aKillSrc, aKillGuarded: Boolean; aGuardedFirst: Boolean=true);
83 destructor Destroy (); override;
85 // íèæåñëåäóþùåå çàìàïëåíî íà fSource
86 function Read (var buffer; count: LongInt): LongInt; override;
87 function Write (const buffer; count: LongInt): LongInt; override;
88 function Seek (const offset: Int64; origin: TSeekOrigin): Int64; override;
89 end;
91 TSFSMemoryStreamRO = class(TCustomMemoryStream)
92 private
93 fFreeMem: Boolean;
94 fMem: Pointer;
96 public
97 constructor Create (pMem: Pointer; pSize: Integer; aFreeMem: Boolean=false);
98 destructor Destroy (); override;
100 function Write (const buffer; count: LongInt): LongInt; override;
101 end;
103 TUnZStream = class(TStream)
104 protected
105 fSrcSt: TStream;
106 fZlibSt: z_stream;
107 fBuffer: PByte;
108 fPos: Int64;
109 fSkipHeader: Boolean;
110 fSize: Int64; // can be -1
111 fSrcStPos: Int64;
112 fSkipToPos: Int64; // >0: skip to this position
113 fKillSrc: Boolean;
115 procedure reset ();
116 function readBuf (var buffer; count: LongInt): LongInt;
117 procedure fixPos ();
118 procedure determineSize ();
120 public
121 // `aSize` can be -1 if stream size is unknown
122 constructor create (asrc: TStream; aSize: Int64; aKillSrc: Boolean; aSkipHeader: boolean=false);
123 destructor destroy (); override;
124 function read (var buffer; count: LongInt): LongInt; override;
125 function write (const buffer; count: LongInt): LongInt; override;
126 function seek (const offset: Int64; origin: TSeekOrigin): Int64; override;
127 end;
129 // fixed memory chunk
130 TSFSMemoryChunkStream = class(TStream)
131 private
132 fFreeMem: Boolean;
133 fMemBuf: PByte;
134 fMemSize: Integer;
135 fCurPos: Integer;
137 public
138 // if `pMem` is `nil`, stream will allocate it
139 constructor Create (pMem: Pointer; pSize: Integer; aFreeMem: Boolean=false);
140 destructor Destroy (); override;
142 procedure setup (pMem: Pointer; pSize: Integer; aFreeMem: Boolean=false);
144 function Seek (const offset: Int64; origin: TSeekOrigin): Int64; override;
145 function Read (var buffer; count: LongInt): LongInt; override;
146 function Write (const buffer; count: LongInt): LongInt; override;
148 property chunkSize: Integer read fMemSize;
149 property chunkData: PByte read fMemBuf;
150 end;
153 implementation
155 uses
156 zinflate;
159 { TSFSPartialStream }
160 constructor TSFSPartialStream.Create (aSrc: TStream; aPos, aSize: Int64; aKillSrc: Boolean; preBuf: Pointer=nil; bufSz: Integer=0);
161 begin
162 inherited Create();
163 ASSERT(aSrc <> nil);
164 if aPos < 0 then aPos := aSrc.Position;
165 if aSize < 0 then aSize := 0;
166 fSource := aSrc;
167 fKillSource := aKillSrc;
168 fLastReadPos := 0;
169 fCurrentPos := 0;
170 fStartPos := aPos;
171 fSize := aSize;
172 if bufSz > 0 then
173 begin
174 SetLength(fPreBuf, bufSz);
175 Move(preBuf^, fPreBuf[0], bufSz);
176 Inc(fSize, bufSz);
177 end
178 else
179 begin
180 fPreBuf := nil;
181 end;
182 end;
184 destructor TSFSPartialStream.Destroy ();
185 begin
186 if fKillSource then FreeAndNil(fSource);
187 inherited Destroy();
188 end;
190 procedure TSFSPartialStream.CheckPos ();
191 begin
193 if fSource.Position <> fStartPos+fCurrentPos-Length(fPreBuf) then
194 begin
195 fSource.Position := fStartPos+fCurrentPos-Length(fPreBuf);
196 end;
198 if fCurrentPos >= length(fPreBuf) then
199 begin
200 //writeln('seeking at ', fCurrentPos, ' (real: ', fStartPos+fCurrentPos-Length(fPreBuf), ')');
201 fSource.Position := fStartPos+fCurrentPos-Length(fPreBuf);
202 end;
203 fLastReadPos := fCurrentPos;
204 end;
206 function TSFSPartialStream.Write (const buffer; count: LongInt): LongInt;
207 begin
208 result := 0;
209 raise XStreamError.Create('can''t write to read-only stream');
210 // à íå õîäè, íåõîðîøèé, â íàø ñàäèê ãóëÿòü!
211 end;
213 function TSFSPartialStream.Read (var buffer; count: LongInt): LongInt;
214 var
215 left: Int64;
216 pc: Pointer;
217 rd: LongInt;
218 begin
219 if count < 0 then raise XStreamError.Create('invalid Read() call'); // ñêàçî÷íûé äîëáî¸á...
220 if count = 0 then begin result := 0; exit; end;
221 pc := @buffer;
222 result := 0;
223 if (Length(fPreBuf) > 0) and (fCurrentPos < Length(fPreBuf)) then
224 begin
225 fLastReadPos := fCurrentPos;
226 left := Length(fPreBuf)-fCurrentPos;
227 if left > count then left := count;
228 if left > 0 then
229 begin
230 Move(fPreBuf[fCurrentPos], pc^, left);
231 Inc(PChar(pc), left);
232 Inc(fCurrentPos, left);
233 fLastReadPos := fCurrentPos;
234 Dec(count, left);
235 result := left;
236 if count = 0 then exit;
237 end;
238 end;
239 CheckPos();
240 left := fSize-fCurrentPos;
241 if left < count then count := left; // è òàê ñëó÷àåòñÿ...
242 if count > 0 then
243 begin
244 rd := fSource.Read(pc^, count);
245 Inc(result, rd);
246 Inc(fCurrentPos, rd);
247 fLastReadPos := fCurrentPos;
248 end
249 else
250 begin
251 result := 0;
252 end;
253 end;
255 function TSFSPartialStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
256 begin
257 case origin of
258 soBeginning: result := offset;
259 soCurrent: result := offset+fCurrentPos;
260 soEnd: result := fSize+offset;
261 else raise XStreamError.Create('invalid Seek() call');
262 // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
263 end;
264 if result < 0 then result := 0
265 else if result > fSize then result := fSize;
266 fCurrentPos := result;
267 end;
270 { TSFSGuardStream }
271 constructor TSFSGuardStream.Create (aSrc, aGuarded: TStream; aKillSrc, aKillGuarded: Boolean; aGuardedFirst: Boolean=true);
272 begin
273 inherited Create();
274 fSource := aSrc; fGuardedStream := aGuarded;
275 fKillSource := aKillSrc; fKillGuarded := aKillGuarded;
276 fGuardedFirst := aGuardedFirst;
277 end;
279 destructor TSFSGuardStream.Destroy ();
280 begin
281 if fKillGuarded and fGuardedFirst then FreeAndNil(fGuardedStream);
282 if fKillSource then FreeAndNil(fSource);
283 if fKillGuarded and not fGuardedFirst then FreeAndNil(fGuardedStream);
284 inherited Destroy();
285 end;
287 function TSFSGuardStream.Read (var buffer; count: LongInt): LongInt;
288 begin
289 result := fSource.Read(buffer, count);
290 end;
292 function TSFSGuardStream.Write (const buffer; count: LongInt): LongInt;
293 begin
294 result := fSource.Write(buffer, count);
295 end;
297 function TSFSGuardStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
298 begin
299 result := fSource.Seek(offset, origin);
300 end;
303 { TSFSMemoryStreamRO }
304 constructor TSFSMemoryStreamRO.Create (pMem: Pointer; pSize: Integer; aFreeMem: Boolean=false);
305 begin
306 fFreeMem := aFreeMem;
307 fMem := pMem;
308 inherited Create();
309 SetPointer(pMem, pSize);
310 Position := 0;
311 end;
313 destructor TSFSMemoryStreamRO.Destroy ();
314 begin
315 if fFreeMem and (fMem <> nil) then FreeMem(fMem);
316 end;
318 function TSFSMemoryStreamRO.Write (const buffer; count: LongInt): LongInt;
319 begin
320 result := 0;
321 raise XStreamError.Create('can''t write to read-only stream');
322 // ñîâñåì ñáðåíäèë...
323 end;
326 // ////////////////////////////////////////////////////////////////////////// //
327 { TUnZStream }
328 const ZBufSize = 32768; // size of the buffer used for temporarily storing data from the child stream
331 constructor TUnZStream.create (asrc: TStream; aSize: Int64; aKillSrc: Boolean; aSkipHeader: boolean=false);
332 var
333 err: Integer;
334 begin
335 fKillSrc := aKillSrc;
336 fPos := 0;
337 fSkipToPos := -1;
338 fSrcSt := asrc;
339 fSize := aSize;
340 GetMem(fBuffer, ZBufSize);
341 fSkipHeader := aSkipHeader;
342 fSrcStPos := fSrcSt.position;
343 FillChar(fZlibSt, sizeof(fZlibSt), 0);
344 if fSkipHeader then err := inflateInit2(fZlibSt, -MAX_WBITS) else err := inflateInit(fZlibSt);
345 if err <> Z_OK then raise XStreamError.Create(zerror(err));
346 end;
349 destructor TUnZStream.destroy ();
350 begin
351 inflateEnd(fZlibSt);
352 FreeMem(fBuffer);
353 if fKillSrc then fSrcSt.Free();
354 inherited Destroy();
355 end;
358 function TUnZStream.readBuf (var buffer; count: LongInt): LongInt;
359 var
360 err: Integer;
361 sz: LongInt;
362 begin
363 result := 0;
364 if (fSize >= 0) and (fPos >= fSize) then exit;
365 if count > 0 then
366 begin
367 fZlibSt.next_out := @buffer;
368 fZlibSt.avail_out := count;
369 sz := fZlibSt.avail_out;
370 while fZlibSt.avail_out > 0 do
371 begin
372 if fZlibSt.avail_in = 0 then
373 begin
374 // refill the buffer
375 fZlibSt.next_in := fBuffer;
376 fZlibSt.avail_in := fSrcSt.read(Fbuffer^, ZBufSize);
377 end;
378 err := inflate(fZlibSt, Z_NO_FLUSH);
379 if (err <> Z_OK) and (err <> Z_STREAM_END) then raise XStreamError.Create(zerror(err));
380 Inc(result, sz-fZlibSt.avail_out);
381 Inc(fPos, sz-fZlibSt.avail_out);
382 sz := fZlibSt.avail_out;
383 if err = Z_STREAM_END then begin fSize := fPos; break; end;
384 end;
385 end;
386 end;
389 procedure TUnZStream.fixPos ();
390 var
391 buf: array [0..4095] of Byte;
392 rd, rr: LongInt;
393 begin
394 if fSkipToPos < 0 then exit;
395 //writeln('fixing pos: fPos=', fPos, '; fSkipToPos=', fSkipToPos);
396 if fSkipToPos < fPos then reset();
397 while fPos < fSkipToPos do
398 begin
399 if fSkipToPos-fPos > 4096 then rd := 4096 else rd := LongInt(fSkipToPos-fPos);
400 //writeln(' reading ', rd, ' bytes...');
401 rr := readBuf(buf, rd);
402 //writeln(' got ', rr, ' bytes; fPos=', fPos, '; fSkipToPos=', fSkipToPos);
403 if rr <= 0 then raise XStreamError.Create('seek error');
404 end;
405 //writeln(' pos: fPos=', fPos, '; fSkipToPos=', fSkipToPos);
406 fSkipToPos := -1;
407 end;
410 procedure TUnZStream.determineSize ();
411 var
412 buf: array [0..4095] of Byte;
413 rd: LongInt;
414 opos: Int64;
415 begin
416 if fSize >= 0 then exit;
417 opos := fPos;
418 try
419 //writeln('determining unzstream size...');
420 while true do
421 begin
422 rd := readBuf(buf, 4096);
423 if rd = 0 then break;
424 end;
425 fSize := fPos;
426 //writeln(' unzstream size is ', fSize);
427 finally
428 if fSkipToPos < 0 then fSkipToPos := opos;
429 end;
430 end;
433 function TUnZStream.read (var buffer; count: LongInt): LongInt;
434 begin
435 if fSkipToPos >= 0 then fixPos();
436 result := readBuf(buffer, count);
437 end;
440 function TUnZStream.write (const buffer; count: LongInt): LongInt;
441 begin
442 result := 0;
443 raise XStreamError.Create('can''t write to read-only stream');
444 end;
447 procedure TUnZStream.reset ();
448 var
449 err: Integer;
450 begin
451 //writeln('doing RESET');
452 fSrcSt.position := fSrcStPos;
453 fPos := 0;
454 inflateEnd(fZlibSt);
455 FillChar(fZlibSt, sizeof(fZlibSt), 0);
456 if fSkipHeader then err := inflateInit2(fZlibSt, -MAX_WBITS) else err := inflateInit(fZlibSt);
457 if err <> Z_OK then raise XStreamError.Create(zerror(err));
458 end;
461 function TUnZStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
462 var
463 cpos: Int64;
464 begin
465 cpos := fPos;
466 if fSkipToPos >= 0 then cpos := fSkipToPos;
467 case origin of
468 soBeginning: result := offset;
469 soCurrent: result := offset+cpos;
470 soEnd: begin determineSize(); result := fSize+offset; end;
471 else raise XStreamError.Create('invalid Seek() call');
472 // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
473 end;
474 if result < 0 then result := 0;
475 fSkipToPos := result;
476 //writeln('seek: ofs=', offset, '; origin=', origin, '; result=', result);
477 end;
480 // ////////////////////////////////////////////////////////////////////////// //
481 constructor TSFSMemoryChunkStream.Create (pMem: Pointer; pSize: Integer; aFreeMem: Boolean=false);
482 begin
483 fMemBuf := nil;
484 fFreeMem := false;
485 fMemSize := 0;
486 fCurPos := 0;
487 setup(pMem, pSize, aFreeMem);
488 end;
491 procedure TSFSMemoryChunkStream.setup (pMem: Pointer; pSize: Integer; aFreeMem: Boolean=false);
492 begin
493 if fFreeMem then FreeMem(fMemBuf);
494 fMemBuf := nil;
495 fFreeMem := false;
496 fMemSize := 0;
497 fCurPos := 0;
498 if (pSize < 0) then raise XStreamError.Create('invalid chunk size');
499 if (pMem = nil) then
500 begin
501 if (pSize > 0) then
502 begin
503 GetMem(pMem, pSize);
504 if (pMem = nil) then raise XStreamError.Create('out of memory for chunk');
505 aFreeMem := true;
506 end
507 else
508 begin
509 aFreeMem := false;
510 end;
511 end;
512 fFreeMem := aFreeMem;
513 fMemBuf := PByte(pMem);
514 fMemSize := pSize;
515 end;
518 destructor TSFSMemoryChunkStream.Destroy ();
519 begin
520 if fFreeMem then FreeMem(fMemBuf);
521 inherited;
522 end;
525 function TSFSMemoryChunkStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
526 begin
527 case origin of
528 soBeginning: result := offset;
529 soCurrent: result := offset+fCurPos;
530 soEnd: result := fMemSize+offset;
531 else raise XStreamError.Create('invalid Seek() call');
532 end;
533 if (result < 0) then raise XStreamError.Create('invalid Seek() call');
534 if (result > fMemSize) then result := fMemSize;
535 fCurPos := result;
536 end;
539 function TSFSMemoryChunkStream.Read (var buffer; count: LongInt): LongInt;
540 var
541 left: Integer;
542 begin
543 if (count < 0) then raise XStreamError.Create('negative read');
544 left := fMemSize-fCurPos;
545 if (left < 0) then raise XStreamError.Create('internal error in TSFSMemoryChunkStream (read)');
546 if (count > left) then count := left;
547 if (count > 0) then Move((fMemBuf+fCurPos)^, buffer, count);
548 Inc(fCurPos, count);
549 result := count;
550 end;
553 function TSFSMemoryChunkStream.Write (const buffer; count: LongInt): LongInt;
554 var
555 left: Integer;
556 begin
557 if (count < 0) then raise XStreamError.Create('negative write');
558 left := fMemSize-fCurPos;
559 if (left < 0) then raise XStreamError.Create('internal error in TSFSMemoryChunkStream (write)');
560 if (count > left) then count := left;
561 if (count > 0) then Move(buffer, (fMemBuf+fCurPos)^, count);
562 Inc(fCurPos, count);
563 result := count;
564 end;
567 end.