aboutsummaryrefslogtreecommitdiffstats
path: root/unicode/src/base
diff options
context:
space:
mode:
Diffstat (limited to 'unicode/src/base')
-rw-r--r--unicode/src/base/UCommon.pas76
-rw-r--r--unicode/src/base/UImage.pas48
2 files changed, 37 insertions, 87 deletions
diff --git a/unicode/src/base/UCommon.pas b/unicode/src/base/UCommon.pas
index c0a98815..1bee9d29 100644
--- a/unicode/src/base/UCommon.pas
+++ b/unicode/src/base/UCommon.pas
@@ -39,7 +39,6 @@ uses
{$IFDEF MSWINDOWS}
Windows,
{$ENDIF}
- sdl,
UConfig,
ULog,
UPath;
@@ -51,8 +50,6 @@ procedure ShowMessage(const msg: string; msgType: TMessageType = mtInfo);
procedure ConsoleWriteLn(const msg: string);
-function RWopsFromStream(Stream: TStream): PSDL_RWops;
-
{$IFDEF FPC}
function RandomRange(aMin: integer; aMax: integer): integer;
{$ENDIF}
@@ -62,8 +59,8 @@ procedure SetDefaultNumericLocale();
procedure RestoreNumericLocale();
{$IFNDEF MSWINDOWS}
- procedure ZeroMemory(Destination: pointer; Length: dword);
- function MakeLong(a, b: word): longint;
+procedure ZeroMemory(Destination: pointer; Length: dword);
+function MakeLong(a, b: word): longint;
{$ENDIF}
type
@@ -91,6 +88,7 @@ uses
{$IFDEF Delphi}
Dialogs,
{$ENDIF}
+ sdl,
UFilesystem,
UMain,
UUnicodeUtils;
@@ -269,74 +267,6 @@ begin
end;
end;
-// +++++++++++++++++++++ helpers for RWOpsFromStream() +++++++++++++++
-function SdlStreamSeek(context: PSDL_RWops; offset: integer; whence: integer): integer; cdecl;
-var
- stream: TStream;
- origin: word;
-begin
- stream := TStream(context.unknown);
- if (stream = nil) then
- raise EInvalidContainer.Create('SDLStreamSeek on nil');
- case whence of
- 0 : origin := soFromBeginning; // Offset is from the beginning of the resource. Seek moves to the position Offset. Offset must be >= 0.
- 1 : origin := soFromCurrent; // Offset is from the current position in the resource. Seek moves to Position + Offset.
- 2 : origin := soFromEnd;
- else
- origin := soFromBeginning; // just in case
- end;
- Result := stream.Seek(offset, origin);
-end;
-
-function SdlStreamRead(context: PSDL_RWops; Ptr: pointer; size: integer; maxnum: integer): integer; cdecl;
-var
- stream: TStream;
-begin
- stream := TStream(context.unknown);
- if (stream = nil) then
- raise EInvalidContainer.Create('SDLStreamRead on nil');
- try
- Result := stream.read(Ptr^, Size * maxnum) div size;
- except
- Result := -1;
- end;
-end;
-
-function SDLStreamClose(context: PSDL_RWops): integer; cdecl;
-var
- stream: TStream;
-begin
- stream := TStream(context.unknown);
- if (stream = nil) then
- raise EInvalidContainer.Create('SDLStreamClose on nil');
- stream.Free;
- Result := 1;
-end;
-// -----------------------------------------------
-
-(*
- * Creates an SDL_RWops handle from a TStream.
- * The stream and RWops must be freed by the user after usage.
- * Use SDL_FreeRW(...) to free the RWops data-struct.
- *)
-function RWopsFromStream(Stream: TStream): PSDL_RWops;
-begin
- Result := SDL_AllocRW();
- if (Result = nil) then
- Exit;
-
- // set RW-callbacks
- with Result^ do
- begin
- unknown := TUnknown(Stream);
- seek := SDLStreamSeek;
- read := SDLStreamRead;
- write := nil;
- close := SDLStreamClose;
- type_ := 2;
- end;
-end;
-
{$IFDEF FPC}
function RandomRange(aMin: integer; aMax: integer): integer;
begin
diff --git a/unicode/src/base/UImage.pas b/unicode/src/base/UImage.pas
index 25b0d1e2..b5d853dd 100644
--- a/unicode/src/base/UImage.pas
+++ b/unicode/src/base/UImage.pas
@@ -182,6 +182,7 @@ uses
zlib,
sdl_image,
sdlutils,
+ sdlstreams,
UCommon,
ULog;
@@ -601,14 +602,15 @@ end;
function WriteJPGImage(const FileName: IPath; Surface: PSDL_Surface; Quality: integer): boolean;
var
{$IFDEF Delphi}
- Bitmap: TBitmap;
+ Bitmap: TBitmap;
BitmapInfo: TBitmapInfo;
- Jpeg: TJpegImage;
- row: integer;
+ Jpeg: TJpegImage;
+ row: integer;
+ FileStream: TBinaryFileStream;
{$ELSE}
cinfo: jpeg_compress_struct;
jerr : jpeg_error_mgr;
- jpgFile: TFileStream;
+ jpgFile: TBinaryFileStream;
rowPtr: array[0..0] of JSAMPROW;
{$ENDIF}
converted: boolean;
@@ -670,19 +672,32 @@ begin
SDL_UnlockSurface(Surface);
// assign Bitmap to JPEG and store the latter
- Jpeg := TJPEGImage.Create;
- Jpeg.Assign(Bitmap);
- Bitmap.Free;
- Jpeg.CompressionQuality := Quality;
try
- // compress image (don't forget this line, otherwise it won't be compressed)
- Jpeg.Compress();
- Jpeg.SaveToFile(FileName.ToNative);
+ // init with nil so Free() will not fail if an exception occurs
+ Jpeg := nil;
+ Bitmap := nil;
+ FileStream := nil;
+
+ try
+ Jpeg := TJPEGImage.Create;
+ Jpeg.Assign(Bitmap);
+
+ // compress image (don't forget this line, otherwise it won't be compressed)
+ Jpeg.CompressionQuality := Quality;
+ Jpeg.Compress();
+
+ // Note: FileStream needed for unicode filename support
+ FileStream := TBinaryFileStream.Create(Filename, fmCreate);
+ Jpeg.SaveToStream(FileStream);
+ finally
+ FileStream.Free;
+ Bitmap.Free;
+ Jpeg.Free;
+ end;
except
Log.LogError('Could not save file: "' + FileName.ToNative + '"', 'WriteJPGImage');
Exit;
end;
- Jpeg.Free;
{$ELSE}
// based on example.pas in FPC's packages/base/pasjpeg directory
@@ -704,7 +719,7 @@ begin
// open file for writing
try
- jpgFile := TFileStream.Create(FileName, fmCreate);
+ jpgFile := TBinaryFileStream.Create(FileName, fmCreate);
except
Log.LogError('Could not open file: "' + FileName + '"', 'WriteJPGImage');
Exit;
@@ -767,6 +782,8 @@ end;
function LoadImage(const Filename: IPath): PSDL_Surface;
var
FilenameCaseAdj: IPath;
+ FileStream: TBinaryFileStream;
+ SDLStream: PSDL_RWops;
begin
Result := nil;
@@ -780,7 +797,10 @@ begin
// load from file
try
- Result := IMG_Load(PChar(FilenameCaseAdj.ToNative));
+ SDLStream := SDLStreamSetup(TBinaryFileStream.Create(FilenameCaseAdj, fmOpenRead));
+ Result := IMG_Load_RW(SDLStream, 1);
+ // Note: the TBinaryFileStream is freed by the SDL-stream. The SDL-stream in
+ // turn is freed automatically by IMG_Load_RW().
except
Log.LogError('Could not load from file "' + FilenameCaseAdj.ToNative + '"', 'LoadImage');
Exit;