fpc/packages/extra/hermes/convert.inc
daniel 4b074a0e5c + Add PTCpas package
git-svn-id: trunk@1944 -
2005-12-13 21:13:29 +00:00

740 lines
23 KiB
PHP

{
Free Pascal port of the Hermes C library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C version by Christian Nentwich (c.nentwich@cs.ucl.ac.uk)
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library 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. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
{Function Hermes_ConverterInstance(flags : DWord) : THermesHandle;
Procedure Hermes_ConverterReturn(handle : THermesHandle);}
Var
{ ConverterList is a list of HermesConverter* }
ConverterList : ^PHermesConverter;
ConvertCurrenthandle : THermesHandle;
Const
lastConverter : Integer = 0; { Array size, one beyond end }
CONVERTrefcount : Integer = 0;
Function Hermes_ConverterInstance(flags : DWord) : THermesHandle;
Var
i : Integer;
newinstance : PHermesConverter;
newlist : ^PHermesConverter;
Begin
{ Initialising, allocate initial size array of converters }
If CONVERTrefcount = 0 Then
Begin
ConverterList := malloc(SizeOf(PHermesConverter) * HERMES_INITIAL);
If ConverterList = Nil Then
Begin
Hermes_ConverterInstance := 0;
Exit;
End;
lastConverter := HERMES_INITIAL;
ConvertCurrenthandle := 1;
For i := 0 To lastConverter - 1 Do
ConverterList[i] := Nil;
{ DEBUG_PRINT("Creating dynamic array(convert.c:57), size %d\n",HERMES_INITIAL)}
End;
{ Uh oh, arrary too small, time for growth }
If ConvertCurrenthandle = lastConverter Then
Begin
{ I'm told realloc isn't completely portable !? Let's do it by hand }
newlist := malloc(SizeOf(PHermesConverter)*(lastConverter+HERMES_GROWTH));
If newlist = Nil Then
Begin
Hermes_ConverterInstance := 0;
Exit;
End;
{ Copy converter pointers }
For i := 0 To lastConverter - 1 Do
newlist[i] := ConverterList[i];
free(ConverterList);
{ Assign new list to old one }
ConverterList := newlist;
Inc(lastConverter, HERMES_GROWTH);
{ DEBUG_PRINT("Growing dynamic array, new size %d\n",lastConverter)}
End;
{ Create a HermesConverter }
newinstance := malloc(sizeof(THermesConverter));
If newinstance = Nil Then
Begin
Hermes_ConverterInstance := 0;
Exit;
End;
{ Zero it out }
newinstance^.loopnormal := Nil;
newinstance^.loopstretch := Nil;
newinstance^.normal := Nil;
newinstance^.stretch := Nil;
newinstance^.dither := Nil;
newinstance^.ditherstretch := Nil;
newinstance^.flags := flags;
FillChar(newinstance^.source, 0, SizeOf(THermesFormat));
FillChar(newinstance^.dest, 0, SizeOf(THermesFormat));
ConverterList[ConvertCurrenthandle] := newinstance;
Inc(CONVERTrefcount);
Inc(ConvertCurrenthandle);
Hermes_ConverterInstance := ConvertCurrenthandle - 1;
End;
Procedure Hermes_ConverterReturn(handle : THermesHandle);
Begin
If (handle < 0) Or (handle >= lastConverter) Then
Exit;
{ Adjust reference count }
Dec(CONVERTrefcount);
If ConverterList[handle] <> Nil Then
Begin
free(ConverterList[handle]);
ConverterList[handle] := Nil;
End;
{ No more references, deinitialise }
If CONVERTrefcount = 0 Then
Begin
If ConverterList <> Nil Then
Begin
free(ConverterList);
ConverterList := Nil;
End;
ConvertCurrenthandle := 0;
lastConverter := 0;
End;
End;
Function Hermes_ConverterRequest(handle : THermesHandle;
source, dest : PHermesFormat) : Boolean;
Var
searchlist : Integer;
i : Integer;
found : Boolean;
cnv : PHermesConverter;
Begin
{ DebugMSG('Hermes_ConverterRequest(' + C2Str(source^.bits)
+ ',' + C2Str(source^.r) + ',' + C2Str(source^.g) + ',' +
C2Str(source^.b) + ';' + C2Str(dest^.bits)
+ ',' + C2Str(dest^.r) + ',' + C2Str(dest^.g) + ',' +
C2Str(dest^.b) + ')');}
Hermes_ConverterRequest := False;
searchlist := 0;
i := 0;
found := False;
{ Check array ranges }
If (handle < 0) Or (handle >= lastConverter) Then
Exit;
If ConverterList[handle] = Nil Then
Exit;
cnv := ConverterList[handle];
{ Cache repeated requests of the same conversion }
If Hermes_FormatEquals(source, @ConverterList[handle]^.source) And
Hermes_FormatEquals(dest, @ConverterList[handle]^.dest) Then
Begin
Hermes_ConverterRequest := True;
Exit;
End;
{ Clear the generic converter flag }
cnv^.flags := cnv^.flags And (Not HERMES_CONVERT_GENERIC);
{ If the source and destination are equal, use copy routines }
If Hermes_FormatEquals(source, dest) Then
Begin
{ DebugMSG('format equals!');}
If ((source^.bits And 7) <> 0) Or (source^.bits > 32) Or
(source^.bits = 0) Then
Exit;
i := (source^.bits Shr 3) - 1;
If equalConverters[i] = Nil Then
Exit;
Hermes_FormatCopy(source, @cnv^.source);
Hermes_FormatCopy(dest, @cnv^.dest);
cnv^.loopnormal := equalConverters[i]^.loopnormal;
cnv^.loopstretch := equalConverters[i]^.loopstretch;
cnv^.normal := equalConverters[i]^.normal;
cnv^.stretch := equalConverters[i]^.stretch;
Hermes_ConverterRequest := True;
Exit;
End;
{ Start looking for specialised converters }
searchlist := $ff;
Case source^.bits Of
32 : If (source^.r = $ff0000) And (source^.g = $ff00) And (source^.b = $ff) Then
searchlist := 0
Else
If (source^.r = ($ff Shl 20)) And
(source^.g = ($ff Shl 10)) And
(source^.b = $ff) Then
searchlist := 3;
24 : If (source^.r = $ff0000) And (source^.g = $ff00) And (source^.b = $ff) Then
searchlist := 1;
16 : If (source^.r = $f800) And (source^.g = $7e0) And (source^.b = $1f) Then
searchlist := 2;
8 : If source^.indexed Then
searchlist := 4;
End;
{ We can use a quicker loop for 8 bit }
If searchlist <> $ff Then
If source^.bits = 8 Then
Begin
For i := 0 To numConverters[searchlist] - 1 Do
If standardConverters[searchlist][i] <> Nil Then
If dest^.bits = standardConverters[searchlist][i]^.dest.bits Then
Begin
Hermes_FormatCopy(source, @cnv^.source);
Hermes_FormatCopy(dest, @cnv^.dest);
cnv^.loopnormal := standardConverters[searchlist][i]^.loopnormal;
cnv^.loopstretch := standardConverters[searchlist][i]^.loopstretch;
cnv^.normal := standardConverters[searchlist][i]^.normal;
cnv^.stretch := standardConverters[searchlist][i]^.stretch;
cnv^.dither := standardConverters[searchlist][i]^.dither;
cnv^.ditherstretch := standardConverters[searchlist][i]^.ditherstretch;
Hermes_ConverterRequest := True;
Exit;
End
;
End
Else
For i := 0 To numConverters[searchlist] - 1 Do
If standardConverters[searchlist][i] <> Nil Then
If Hermes_FormatEquals(@standardConverters[searchlist][i]^.source, source) And
Hermes_FormatEquals(@standardConverters[searchlist][i]^.dest, dest) Then
Begin
Hermes_FormatCopy(source, @cnv^.source);
Hermes_FormatCopy(dest, @cnv^.dest);
cnv^.loopnormal := standardConverters[searchlist][i]^.loopnormal;
cnv^.loopstretch := standardConverters[searchlist][i]^.loopstretch;
cnv^.normal := standardConverters[searchlist][i]^.normal;
cnv^.stretch := standardConverters[searchlist][i]^.stretch;
cnv^.dither := standardConverters[searchlist][i]^.dither;
cnv^.ditherstretch := standardConverters[searchlist][i]^.ditherstretch;
Hermes_ConverterRequest := True;
Exit;
End;
{ Otherwise find a generic converter }
{ DebugMSG('looking for a generic converter!');}
cnv^.loopnormal := Nil;
cnv^.loopstretch := Nil;
cnv^.dither := Nil;
cnv^.ditherstretch := Nil;
cnv^.flags := cnv^.flags Or HERMES_CONVERT_GENERIC;
{ Generic routines implement whole converters not scanline converters,
assign placeholders }
cnv^.normal := @NotApplicable;
cnv^.stretch := @NotApplicable;
found := False;
{
Converting rules:
C -> C
C -> A
A -> O, A -> A
A -> C
O -> O , A, C are the same
}
If source^.has_colorkey And dest^.has_colorkey Then { Ck -> Ck }
Case source^.bits Of
32 : Case dest^.bits Of
32 : Begin
cnv^.loopnormal := @ConvertP_Generic32_C_Generic32_C;
cnv^.loopstretch := @ConvertP_Generic32_C_Generic32_C_S;
found := True;
End;
24 : Begin
cnv^.loopnormal := @ConvertP_Generic32_C_Generic24_C;
found := True;
End;
16 : Begin
cnv^.loopnormal := @ConvertP_Generic32_C_Generic16_C;
cnv^.loopstretch := @ConvertP_Generic32_C_Generic16_C_S;
found := True;
End;
8 : Begin
cnv^.loopnormal := @ConvertP_Generic32_C_Generic8_C;
found := True;
End;
End;
24 : Case dest^.bits Of
32 : Begin
cnv^.loopnormal := @ConvertP_Generic24_C_Generic32_C;
found := True;
End;
24 : Begin
cnv^.loopnormal := @ConvertP_Generic24_C_Generic24_C;
found := True;
End;
16 : Begin
cnv^.loopnormal := @ConvertP_Generic24_C_Generic16_C;
found := True;
End;
8 : Begin
cnv^.loopnormal := @ConvertP_Generic24_C_Generic8_C;
found := True;
End;
End;
16 : Case dest^.bits Of
32 : Begin
cnv^.loopnormal := @ConvertP_Generic16_C_Generic32_C;
found := True;
End;
24 : Begin
cnv^.loopnormal := @ConvertP_Generic16_C_Generic24_C;
found := True;
End;
16 : Begin
cnv^.loopnormal := @ConvertP_Generic16_C_Generic16_C;
found := True;
End;
8 : Begin
cnv^.loopnormal := @ConvertP_Generic16_C_Generic8_C;
found := True;
End;
End;
End
Else
If source^.has_colorkey And (dest^.a <> 0) Then { Ck -> A }
Case source^.bits Of
32 : Case dest^.bits Of
32 : Begin
cnv^.loopnormal := @ConvertP_Generic32_C_Generic32_A;
cnv^.loopstretch := @ConvertP_Generic32_C_Generic32_A_S;
found := True;
End;
24 : Begin
cnv^.loopnormal := @ConvertP_Generic32_C_Generic24_A;
found := True;
End;
16 : Begin
cnv^.loopnormal := @ConvertP_Generic32_C_Generic16_A;
cnv^.loopstretch := @ConvertP_Generic32_C_Generic16_A_S;
found := True;
End;
8 : Begin
cnv^.loopnormal := @ConvertP_Generic32_C_Generic8_A;
found := True;
End;
End;
24 : Case dest^.bits Of
32 : Begin
cnv^.loopnormal := @ConvertP_Generic24_C_Generic32_A;
found := True;
End;
24 : Begin
cnv^.loopnormal := @ConvertP_Generic24_C_Generic24_A;
found := True;
End;
16 : Begin
cnv^.loopnormal := @ConvertP_Generic24_C_Generic16_A;
found := True;
End;
8 : Begin
cnv^.loopnormal := @ConvertP_Generic24_C_Generic8_A;
found := True;
End;
End;
16 : Case dest^.bits Of
32 : Begin
cnv^.loopnormal := @ConvertP_Generic16_C_Generic32_A;
found := True;
End;
24 : Begin
cnv^.loopnormal := @ConvertP_Generic16_C_Generic24_A;
found := True;
End;
16 : Begin
cnv^.loopnormal := @ConvertP_Generic16_C_Generic16_A;
found := True;
End;
8 : Begin
cnv^.loopnormal := @ConvertP_Generic16_C_Generic8_A;
found := True;
End;
End;
End
Else
If (source^.a <> 0) And dest^.has_colorkey Then { A -> Ck }
Case source^.bits Of
32 : Case dest^.bits Of
32 : Begin
cnv^.loopnormal := @ConvertP_Generic32_A_Generic32_C;
cnv^.loopstretch := @ConvertP_Generic32_A_Generic32_C_S;
found := True;
End;
24 : Begin
cnv^.loopnormal := @ConvertP_Generic32_A_Generic24_C;
found := True;
End;
16 : Begin
cnv^.loopnormal := @ConvertP_Generic32_A_Generic16_C;
cnv^.loopnormal := @ConvertP_Generic32_A_Generic16_C_S;
found := True;
End;
8 : Begin
cnv^.loopnormal := @ConvertP_Generic32_A_Generic8_C;
found := True;
End;
End;
24 : Case dest^.bits Of
32 : Begin
cnv^.loopnormal := @ConvertP_Generic24_A_Generic32_C;
found := True;
End;
24 : Begin
cnv^.loopnormal := @ConvertP_Generic24_A_Generic24_C;
found := True;
End;
16 : Begin
cnv^.loopnormal := @ConvertP_Generic24_A_Generic16_C;
found := True;
End;
8 : Begin
cnv^.loopnormal := @ConvertP_Generic24_A_Generic8_C;
found := True;
End;
End;
16 : Case dest^.bits Of
32 : Begin
cnv^.loopnormal := @ConvertP_Generic16_A_Generic32_C;
found := True;
End;
24 : Begin
cnv^.loopnormal := @ConvertP_Generic16_A_Generic24_C;
found := True;
End;
16 : Begin
cnv^.loopnormal := @ConvertP_Generic16_A_Generic16_C;
found := True;
End;
8 : Begin
cnv^.loopnormal := @ConvertP_Generic16_A_Generic8_C;
found := True;
End;
End;
End
Else
If (source^.a <> 0) And (dest^.a <> 0) Then { A -> A }
Case source^.bits Of
32 : Case dest^.bits Of
32 : Begin
cnv^.loopnormal := @ConvertP_Generic32_A_Generic32_A;
cnv^.loopstretch := @ConvertP_Generic32_A_Generic32_A_S;
found := True;
End;
24 : Begin
cnv^.loopnormal := @ConvertP_Generic32_A_Generic24_A;
found := True;
End;
16 : Begin
cnv^.loopnormal := @ConvertP_Generic32_A_Generic16_A;
cnv^.loopstretch := @ConvertP_Generic32_A_Generic16_A_S;
found := True;
End;
8 : Begin
cnv^.loopnormal := @ConvertP_Generic32_A_Generic8_A;
found := True;
End;
End;
24 : Case dest^.bits Of
32 : Begin
cnv^.loopnormal := @ConvertP_Generic24_A_Generic32_A;
found := True;
End;
24 : Begin
cnv^.loopnormal := @ConvertP_Generic24_A_Generic24_A;
found := True;
End;
16 : Begin
cnv^.loopnormal := @ConvertP_Generic24_A_Generic16_A;
found := True;
End;
8 : Begin
cnv^.loopnormal := @ConvertP_Generic24_A_Generic8_A;
found := True;
End;
End;
16 : Case dest^.bits Of
32 : Begin
cnv^.loopnormal := @ConvertP_Generic16_A_Generic32_A;
found := True;
End;
24 : Begin
cnv^.loopnormal := @ConvertP_Generic16_A_Generic24_A;
found := True;
End;
16 : Begin
cnv^.loopnormal := @ConvertP_Generic16_A_Generic16_A;
found := True;
End;
8 : Begin
cnv^.loopnormal := @ConvertP_Generic16_A_Generic8_A;
found := True;
End;
End;
End
Else { O->O, O->A, A->O, Ck->O, O->Ck }
Case source^.bits Of
32 : Case dest^.bits Of
32 : Begin
cnv^.loopnormal := @ConvertP_Generic32_Generic32;
cnv^.loopstretch := @ConvertP_Generic32_Generic32_S;
found := True;
End;
24 : Begin
cnv^.loopnormal := @ConvertP_Generic32_Generic24;
cnv^.loopstretch := @ConvertP_Generic32_Generic24_S;
found := True;
End;
16 : Begin
cnv^.loopnormal := @ConvertP_Generic32_Generic16;
cnv^.loopstretch := @ConvertP_Generic32_Generic16_S;
found := True;
End;
8 : Begin
cnv^.loopnormal := @ConvertP_Generic32_Generic8;
cnv^.loopstretch := @ConvertP_Generic32_Generic8_S;
found := True;
End;
End;
24 : Case dest^.bits Of
32 : Begin
cnv^.loopnormal := @ConvertP_Generic24_Generic32;
cnv^.loopstretch := @ConvertP_Generic24_Generic32_S;
found := True;
End;
24 : Begin
cnv^.loopnormal := @ConvertP_Generic24_Generic24;
cnv^.loopstretch := @ConvertP_Generic24_Generic24_S;
found := True;
End;
16 : Begin
cnv^.loopnormal := @ConvertP_Generic24_Generic16;
cnv^.loopstretch := @ConvertP_Generic24_Generic16_S;
found := True;
End;
8 : Begin
cnv^.loopnormal := @ConvertP_Generic24_Generic8;
cnv^.loopstretch := @ConvertP_Generic24_Generic8_S;
found := True;
End;
End;
16 : Case dest^.bits Of
32 : Begin
cnv^.loopnormal := @ConvertP_Generic16_Generic32;
cnv^.loopstretch := @ConvertP_Generic16_Generic32_S;
found := True;
End;
24 : Begin
cnv^.loopnormal := @ConvertP_Generic16_Generic24;
cnv^.loopstretch := @ConvertP_Generic16_Generic24_S;
found := True;
End;
16 : Begin
cnv^.loopnormal := @ConvertP_Generic16_Generic16;
cnv^.loopstretch := @ConvertP_Generic16_Generic16_S;
found := True;
End;
8 : Begin
cnv^.loopnormal := @ConvertP_Generic16_Generic8;
cnv^.loopstretch := @ConvertP_Generic16_Generic8_S;
found := True;
End;
End;
End;
If found Then
Begin
Hermes_FormatCopy(source, @cnv^.source);
Hermes_FormatCopy(dest, @cnv^.dest);
Hermes_ConverterRequest := True;
Exit;
End;
DebugMSG('no converter found!!!');
{ No converter found, fail }
Hermes_ConverterRequest := False;
End;
Function Hermes_ConverterPalette(handle, sourcepal, destpal : THermesHandle) : Boolean;
Begin
{ DebugMSG('Hermes_ConverterPalette('+C2Str(sourcepal)+','+C2Str(destpal)+')');}
Hermes_ConverterPalette := False;
If (handle < 0) Or (handle >= lastConverter) Then
Exit;
If ConverterList[handle] = Nil Then
Exit;
{ Fail silently if not indexed colour format }
If Not ConverterList[handle]^.source.indexed Then
Begin
ConverterList[handle]^.lookup := Nil;
Hermes_ConverterPalette := True;
Exit;
End;
ConverterList[handle]^.lookup :=
Hermes_PaletteGetTable(sourcepal, @ConverterList[handle]^.dest);
If ConverterList[handle]^.lookup = Nil Then
Exit;
Hermes_ConverterPalette := True;
End;
Function Hermes_ConverterCopy(handle : THermesHandle; s_pixels : Pointer;
s_x, s_y, s_width, s_height, s_pitch : Integer;
d_pixels : Pointer; d_x, d_y, d_width,
d_height, d_pitch : Integer) : Boolean;
Var
cnv : PHermesConverter;
iface : THermesConverterInterface;
Begin
Hermes_ConverterCopy := False;
If (handle < 0) Or (handle >= lastConverter) Then
Exit;
cnv := ConverterList[handle];
If cnv = Nil Then
Exit;
{ Returns success if height or width is zero. This is debatable.. ! }
If (s_width <= 0) Or (s_height <= 0) Or (d_width <= 0) Or (d_height <= 0) Then
Begin
Hermes_ConverterCopy := True;
Exit;
End;
iface.s_pixels := s_pixels;
iface.s_width := s_width;
iface.s_height := s_height;
iface.s_add := s_pitch - s_width * (cnv^.source.bits Shr 3);
iface.s_pitch := s_pitch;
iface.d_pixels := d_pixels;
iface.d_width := d_width;
iface.d_height := d_height;
iface.d_add := d_pitch - d_width*(cnv^.dest.bits Shr 3);
iface.d_pitch := d_pitch;
Inc(iface.s_pixels, s_y * s_pitch + s_x * (cnv^.source.bits Shr 3));
Inc(iface.d_pixels, d_y * d_pitch + d_x * (cnv^.dest.bits Shr 3));
iface.s_has_colorkey := cnv^.source.has_colorkey;
iface.d_has_colorkey := cnv^.dest.has_colorkey;
iface.s_colorkey := cnv^.source.colorkey;
iface.d_colorkey := cnv^.dest.colorkey;
iface.lookup := cnv^.lookup;
{ For generic converters, do some extra setup (find shifts, etc.)
TODO: Move that out of here and in the request routine ! }
If (cnv^.flags And HERMES_CONVERT_GENERIC) <> 0 Then
Begin
Hermes_Calculate_Generic_Info(Hermes_Topbit(cnv^.source.r),
Hermes_Topbit(cnv^.source.g),
Hermes_Topbit(cnv^.source.b),
Hermes_Topbit(cnv^.source.a),
Hermes_Topbit(cnv^.dest.r),
Hermes_Topbit(cnv^.dest.g),
Hermes_Topbit(cnv^.dest.b),
Hermes_Topbit(cnv^.dest.a),
@iface.info);
iface.mask_r := cnv^.dest.r;
iface.mask_g := cnv^.dest.g;
iface.mask_b := cnv^.dest.b;
iface.mask_a := cnv^.dest.a;
End;
{ Check for dithering. This should not be in here but in request as well }
If (cnv^.flags And HERMES_CONVERT_DITHER) <> 0 Then
Begin
{ If there is a ditherer, use it else fall back to normal }
If cnv^.dither <> Nil Then
cnv^.loopnormal := cnv^.dither;
End;
{ Normal conversion }
If (s_width = d_width) And (s_height = d_height) Then
Begin
If (cnv^.normal = Nil) Or (cnv^.loopnormal = Nil) Then
Exit;
{ Optimization
If (iface.s_add = 0) And (iface.d_add = 0) Then
Begin
iface.s_width := iface.s_width * s_height;
iface.d_width := iface.d_width * d_height;
iface.s_height := 1;
iface.d_height := 1;
End;}
iface.func := cnv^.normal;
cnv^.loopnormal(@iface);
Hermes_ConverterCopy := True;
Exit;
End
{ Stretch conversion }
Else
Begin
If (cnv^.stretch = Nil) Or (cnv^.loopstretch = Nil) Then
Exit;
iface.func := cnv^.stretch;
cnv^.loopstretch(@iface);
End;
Hermes_ConverterCopy := True;
End;