summaryrefslogtreecommitdiff
path: root/gfx/emulayer/gelimage.pas
diff options
context:
space:
mode:
Diffstat (limited to 'gfx/emulayer/gelimage.pas')
-rw-r--r--gfx/emulayer/gelimage.pas399
1 files changed, 399 insertions, 0 deletions
diff --git a/gfx/emulayer/gelimage.pas b/gfx/emulayer/gelimage.pas
new file mode 100644
index 00000000..0701e2fc
--- /dev/null
+++ b/gfx/emulayer/gelimage.pas
@@ -0,0 +1,399 @@
+{
+ fpGFX - Free Pascal Graphics Library
+ Copyright (C) 2000 - 2001 by
+ Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org
+ Copyright (C) 2006 by Graeme Geldenhuys
+ member of the fpGFX development team.
+
+ Image conversion helpers
+
+ See the file COPYING.modifiedLGPL, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+unit GELImage;
+
+{$IFDEF Debug}
+{$ASSERTIONS On}
+{$ENDIF}
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes,
+ GfxBase; // fpGFX units
+
+
+procedure ConvertImage(
+ ASourceRect: TRect; ASourceFormat: TGfxPixelFormat; ASourcePal: TGfxPalette;
+ ASourceData: Pointer; ASourceStride: LongWord;
+ ADestX, ADestY: Integer; ADestFormat: TGfxPixelFormat;
+ ADestData: Pointer; ADestStride: LongWord);
+
+procedure FlipMonoImageBits(
+ ASourceRect: TRect; ASourceData: Pointer; ASourceStride: LongWord;
+ ADestX, ADestY: Integer; ADestData: Pointer; ADestStride: LongWord);
+
+
+implementation
+
+type
+ TConvertParams = record
+ RedShiftR, RedShiftL,
+ GreenShiftR, GreenShiftL,
+ BlueShiftR, BlueShiftL: Byte;
+ RedMask, GreenMask, BlueMask: LongWord;
+ RedMult, GreenMult, BlueMult: Word;
+ Palette: array[0..255] of LongWord;
+ end;
+
+ TConvertToInternalProc = procedure(Params: TConvertParams; Data: Pointer;
+ StartX, EndX: Integer; Dest: Pointer);
+
+ TConvertFromInternalProc = procedure(Params: TConvertParams; Data: Pointer;
+ Dest: Pointer; Width: Integer);
+
+
+procedure ConvertMonoToInternal(Params: TConvertParams; Data: Pointer;
+ StartX, EndX: Integer; Dest: Pointer);
+var
+ b: Byte;
+ Mask: Byte;
+begin
+ Inc(Data, StartX shr 3);
+ Mask := 1 shl (7 - StartX and 7);
+ while StartX < EndX do
+ begin
+ PLongWord(Dest)^ := Params.Palette[Ord((PByte(Data)^ and Mask) <> 0)];
+ if Mask = 1 then
+ begin
+ Inc(Data);
+ Mask := 128;
+ end else
+ Mask := Mask shr 1;
+ Inc(StartX);
+ Inc(Dest, 4);
+ end;
+end;
+
+procedure ConvertPal4ToInternal(Params: TConvertParams; Data: Pointer;
+ StartX, EndX: Integer; Dest: Pointer);
+var
+ b: Byte;
+begin
+ // !!!: Just works for even StartX and EndX values
+ ASSERT((StartX and 1) = 0);
+ ASSERT((EndX and 1) = 0);
+ Inc(Data, StartX shr 1);
+ while StartX < EndX do
+ begin
+ b := PByte(Data)^;
+ PLongWord(Dest)[0] := Params.Palette[b shr 4];
+ PLongWord(Dest)[1] := Params.Palette[b and 15];
+ Inc(StartX, 2);
+ Inc(Data);
+ Inc(Dest, 8);
+ end;
+end;
+
+procedure ConvertPal8ToInternal(Params: TConvertParams; Data: Pointer;
+ StartX, EndX: Integer; Dest: Pointer);
+begin
+ Inc(Data, StartX);
+ while StartX < EndX do
+ begin
+ PLongWord(Dest)^ := Params.Palette[PByte(Data)^];
+ Inc(StartX);
+ Inc(Data);
+ Inc(Dest, 4);
+ end;
+end;
+
+procedure ConvertRGB24ToInternal(Params: TConvertParams; Data: Pointer;
+ StartX, EndX: Integer; Dest: Pointer);
+var
+ PixelIn: LongWord;
+begin
+ Inc(Data, StartX * 3);
+ while StartX < EndX do
+ begin
+ PixelIn := 0;
+ Move(Data^, PixelIn, 3);
+ PLongWord(Dest)^ :=
+ (((PixelIn shr Params.RedShiftR) and $ff) shl Params.RedShiftL) or
+ (((PixelIn shr Params.GreenShiftR) and $ff) shl Params.GreenShiftL) or
+ (((PixelIn shr Params.BlueShiftR) and $ff) shl Params.BlueShiftL);
+ Inc(StartX);
+ Inc(Data, 3);
+ Inc(Dest, 4);
+ end;
+end;
+
+procedure ConvertRGB32ToInternal(Params: TConvertParams; Data: Pointer;
+ StartX, EndX: Integer; Dest: Pointer);
+var
+ PixelIn: LongWord;
+begin
+ Inc(Data, StartX * 4);
+ while StartX < EndX do
+ begin
+ PixelIn := PLongWord(Data)^;
+ PLongWord(Dest)^ :=
+ (((PixelIn shr Params.RedShiftR) and $ff) shl Params.RedShiftL) or
+ (((PixelIn shr Params.GreenShiftR) and $ff) shl Params.GreenShiftL) or
+ (((PixelIn shr Params.BlueShiftR) and $ff) shl Params.BlueShiftL);
+ Inc(StartX);
+ Inc(Data, 4);
+ Inc(Dest, 4);
+ end;
+end;
+
+
+procedure ConvertInternalToRGB16(Params: TConvertParams; Data: Pointer;
+ Dest: Pointer; Width: Integer);
+var
+ PixelIn: LongWord;
+begin
+ repeat
+ PixelIn := PLongWord(Data)^;
+ PWord(Dest)^ :=
+ (((PixelIn and $0000ff) shr Params.RedShiftR) shl Params.RedShiftL) or
+ (((PixelIn and $00ff00) shr Params.GreenShiftR) shl Params.GreenShiftL) or
+ (((PixelIn and $ff0000) shr Params.BlueShiftR) shl Params.BlueShiftL);
+
+ Inc(Data, 4);
+ Inc(Dest, 2);
+ Dec(Width);
+ until Width = 0;
+end;
+
+procedure ConvertInternalToRGB24(Params: TConvertParams; Data: Pointer;
+ Dest: Pointer; Width: Integer);
+var
+ PixelIn, PixelOut: LongWord;
+begin
+ repeat
+ PixelIn := PLongWord(Data)^;
+ PixelOut :=
+ (((PixelIn and $0000ff) shr Params.RedShiftR) shl Params.RedShiftL) or
+ (((PixelIn and $00ff00) shr Params.GreenShiftR) shl Params.GreenShiftL) or
+ (((PixelIn and $ff0000) shr Params.BlueShiftR) shl Params.BlueShiftL);
+ PWord(Dest)^ := Word(PixelOut);
+ PByte(Dest)[2] := PixelOut shr 16;
+
+ Inc(Data, 4);
+ Inc(Dest, 3);
+ Dec(Width);
+ until Width = 0;
+end;
+
+procedure ConvertInternalToRGB32(Params: TConvertParams; Data: Pointer;
+ Dest: Pointer; Width: Integer);
+var
+ PixelIn: LongWord;
+begin
+ repeat
+ PixelIn := PLongWord(Data)^;
+ PLongWord(Dest)^ :=
+ (((PixelIn and $0000ff) shr Params.RedShiftR) shl Params.RedShiftL) or
+ (((PixelIn and $00ff00) shr Params.GreenShiftR) shl Params.GreenShiftL) or
+ (((PixelIn and $ff0000) shr Params.BlueShiftR) shl Params.BlueShiftL);
+
+ Inc(Data, 4);
+ Inc(Dest, 4);
+ Dec(Width);
+ until Width = 0;
+end;
+
+
+function GetBitShiftAndCount(Mask: LongWord; var Shift: Byte): Integer;
+begin
+ Shift := 0;
+ while (Mask and 1) = 0 do
+ begin
+ Mask := Mask shr 1;
+ Inc(Shift);
+ end;
+ Result := 0;
+ while Mask > 0 do
+ begin
+ Mask := Mask shr 1;
+ Inc(Result);
+ end;
+end;
+
+procedure SetupShifts(PixelFormat: TGfxPixelFormat; var Params: TConvertParams);
+begin
+ Params.RedShiftR := 8 -
+ GetBitShiftAndCount(PixelFormat.RedMask, Params.RedShiftL);
+ Params.GreenShiftR := 16 -
+ GetBitShiftAndCount(PixelFormat.GreenMask, Params.GreenShiftL);
+ Params.BlueShiftR := 24 -
+ GetBitShiftAndCount(PixelFormat.BlueMask, Params.BlueShiftL);
+end;
+
+procedure ConvertImage(
+ ASourceRect: TRect; ASourceFormat: TGfxPixelFormat; ASourcePal: TGfxPalette;
+ ASourceData: Pointer; ASourceStride: LongWord;
+ ADestX, ADestY: Integer; ADestFormat: TGfxPixelFormat;
+ ADestData: Pointer; ADestStride: LongWord);
+
+ // returns the highest processed index
+ function ConvertPalette(MaxIndex: Integer;
+ var Params: TConvertParams): Integer;
+ var
+ i: Integer;
+ begin
+ if Assigned(ASourcePal) then
+ begin
+ Result := ASourcePal.EntryCount - 1;
+ if Result > 255 then
+ Result := 255;
+ for i := 0 to Result do
+ with ASourcePal.Entries[i] do
+ Params.Palette[i] :=
+ (Red div 257) or
+ ((Green div 257) shl 8) or
+ ((Blue div 257) shl 16);
+ end else
+ Result := -1;
+ end;
+
+var
+ ParamsS2I, ParamsI2D: TConvertParams; // Source to internal, internal to dest
+ ConvertToInternal: TConvertToInternalProc;
+ ConvertFromInternal: TConvertFromInternalProc;
+ Scanline: Pointer;
+ i, max, w, y: Integer;
+begin
+ case ASourceFormat.FormatType of
+ ftMono:
+ begin
+ ConvertToInternal := @ConvertMonoToInternal;
+ max := ConvertPalette(1, ParamsS2I);
+ if max < 1 then
+ begin
+ ParamsS2I.Palette[1] := $ffffff;
+ if max < 0 then
+ ParamsS2I.Palette[0] := 0;
+ end;
+ end;
+ ftPal4, ftPal4A:
+ begin
+ ConvertToInternal := @ConvertPal4ToInternal;
+ max := ConvertPalette(15, ParamsS2I);
+ for i := max + 1 to 15 do
+ ParamsS2I.Palette[i] := 0;
+ end;
+ ftPal8, ftPal8A:
+ begin
+ ConvertToInternal := @ConvertPal8ToInternal;
+ max := ConvertPalette(255, ParamsS2I);
+ for i := max + 1 to 255 do
+ ParamsS2I.Palette[i] := i or (i shl 8) or (i shl 16);
+ end;
+ ftRGB24:
+ begin
+ ConvertToInternal := @ConvertRGB24ToInternal;
+ ParamsS2I.RedShiftR := 8 -
+ GetBitShiftAndCount(ASourceFormat.RedMask, ParamsS2I.RedShiftL);
+ ParamsS2I.GreenShiftR := 16 -
+ GetBitShiftAndCount(ASourceFormat.GreenMask, ParamsS2I.GreenShiftL);
+ ParamsS2I.BlueShiftR := 24 -
+ GetBitShiftAndCount(ASourceFormat.BlueMask, ParamsS2I.BlueShiftL);
+ end;
+ ftRGB32:
+ begin
+ ConvertToInternal := @ConvertRGB32ToInternal;
+ ParamsS2I.RedShiftR := 8 -
+ GetBitShiftAndCount(ASourceFormat.RedMask, ParamsS2I.RedShiftL);
+ ParamsS2I.GreenShiftR := 16 -
+ GetBitShiftAndCount(ASourceFormat.GreenMask, ParamsS2I.GreenShiftL);
+ ParamsS2I.BlueShiftR := 24 -
+ GetBitShiftAndCount(ASourceFormat.BlueMask, ParamsS2I.BlueShiftL);
+ end;
+ else
+ raise EGfxUnsupportedPixelFormat.Create(ASourceFormat);
+ end;
+
+ case ADestFormat.FormatType of
+ ftRGB16:
+ begin
+ ConvertFromInternal := @ConvertInternalToRGB16;
+ SetupShifts(ADestFormat, ParamsI2D);
+ end;
+ ftRGB24:
+ begin
+ ConvertFromInternal := @ConvertInternalToRGB24;
+ SetupShifts(ADestFormat, ParamsI2D);
+ end;
+ ftRGB32:
+ begin
+ ConvertFromInternal := @ConvertInternalToRGB32;
+ SetupShifts(ADestFormat, ParamsI2D);
+ end;
+ else
+ raise EGfxUnsupportedPixelFormat.Create(ASourceFormat);
+ end;
+
+ w := ASourceRect.Right - ASourceRect.Left;
+ GetMem(Scanline, w * SizeOf(TGfxPixel));
+ for y := ASourceRect.Top to ASourceRect.Bottom - 1 do
+ begin
+ ConvertToInternal(ParamsS2I, ASourceData,
+ ASourceRect.Left, ASourceRect.Right, Scanline);
+ Inc(ASourceData, ASourceStride);
+ ConvertFromInternal(ParamsI2D, Scanline, ADestData, w);
+ Inc(ADestData, ADestStride);
+ end;
+ FreeMem(Scanline);
+end;
+
+
+procedure FlipMonoImageBits(
+ ASourceRect: TRect; ASourceData: Pointer; ASourceStride: LongWord;
+ ADestX, ADestY: Integer; ADestData: Pointer; ADestStride: LongWord);
+const
+ BitFlipTable: array[Byte] of Byte = (
+ $00, $80, $40, $C0, $20, $A0, $60, $E0, $10, $90, $50, $D0, $30, $B0, $70, $F0,
+ $08, $88, $48, $C8, $28, $A8, $68, $E8, $18, $98, $58, $D8, $38, $B8, $78, $F8,
+ $04, $84, $44, $C4, $24, $A4, $64, $E4, $14, $94, $54, $D4, $34, $B4, $74, $F4,
+ $0C, $8C, $4C, $CC, $2C, $AC, $6C, $EC, $1C, $9C, $5C, $DC, $3C, $BC, $7C, $FC,
+ $02, $82, $42, $C2, $22, $A2, $62, $E2, $12, $92, $52, $D2, $32, $B2, $72, $F2,
+ $0A, $8A, $4A, $CA, $2A, $AA, $6A, $EA, $1A, $9A, $5A, $DA, $3A, $BA, $7A, $FA,
+ $06, $86, $46, $C6, $26, $A6, $66, $E6, $16, $96, $56, $D6, $36, $B6, $76, $F6,
+ $0E, $8E, $4E, $CE, $2E, $AE, $6E, $EE, $1E, $9E, $5E, $DE, $3E, $BE, $7E, $FE,
+ $01, $81, $41, $C1, $21, $A1, $61, $E1, $11, $91, $51, $D1, $31, $B1, $71, $F1,
+ $09, $89, $49, $C9, $29, $A9, $69, $E9, $19, $99, $59, $D9, $39, $B9, $79, $F9,
+ $05, $85, $45, $C5, $25, $A5, $65, $E5, $15, $95, $55, $D5, $35, $B5, $75, $F5,
+ $0D, $8D, $4D, $CD, $2D, $AD, $6D, $ED, $1D, $9D, $5D, $DD, $3D, $BD, $7D, $FD,
+ $03, $83, $43, $C3, $23, $A3, $63, $E3, $13, $93, $53, $D3, $33, $B3, $73, $F3,
+ $0B, $8B, $4B, $CB, $2B, $AB, $6B, $EB, $1B, $9B, $5B, $DB, $3B, $BB, $7B, $FB,
+ $07, $87, $47, $C7, $27, $A7, $67, $E7, $17, $97, $57, $D7, $37, $B7, $77, $F7,
+ $0F, $8F, $4F, $CF, $2F, $AF, $6F, $EF, $1F, $9F, $5F, $DF, $3F, $BF, $7F, $FF);
+var
+ StartByte, EndByte, x, y: Integer;
+begin
+ StartByte := ASourceRect.Left shr 3;
+ EndByte := (ASourceRect.Right + 7) shr 3;
+ Inc(ASourceData, StartByte);
+ Dec(EndByte, StartByte);
+ for y := ASourceRect.Top to ASourceRect.Bottom - 1 do
+ begin
+ for x := 0 to EndByte do
+ PByte(ADestData)[x] := BitFlipTable[PByte(ASourceData)[x]];
+ Inc(ASourceData, ASourceStride);
+ Inc(ADestData, ADestStride);
+ end;
+end;
+
+end.
+
+
generated by cgit v1.2.3-54-g00ecf (git 2.44.0) at 2024-08-19 06:21:10 +0000