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

399 lines
10 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
}
Var
Processor : Integer;
Procedure Hermes_Factory_Init;
Var
res : Integer;
Begin
res := 0;
Processor := PROC_GENERIC;
{$IFDEF I386_ASSEMBLER}
Processor := Processor Or PROC_X86_PENTIUM;{There are no others at the moment}
res := Hermes_X86_CPU;
If (res And $800000) <> 0 Then
Begin
// Writeln('mmx disabled for debugging');
Processor := Processor Or PROC_MMX_PENTIUM;
{ Writeln('mmx!');}
End;
{$ENDIF I386_ASSEMBLER}
End;
Function Hermes_Factory_getClearer(bits : int32) : PHermesClearer;
Var
tmp : PHermesClearer;
Begin
{ Try different processors in order of priority..
Note that for this to work, an MMX processor has to have both MMX and
X86 flags }
tmp := malloc(SizeOf(THermesClearer));
If tmp = Nil Then
Begin
Hermes_Factory_getClearer := Nil;
Exit;
End;
tmp^.bits := bits;
Hermes_Factory_getClearer := tmp;
{$IFDEF I386_ASSEMBLER}
If (Processor And PROC_MMX_PENTIUM) <> 0 Then
Case bits Of
32 : Begin
tmp^.func := @ClearMMX_32;
Exit;
End;
24 : ;
16 : Begin
tmp^.func := @ClearMMX_16;
Exit;
End;
8 : Begin
tmp^.func := @ClearMMX_8;
Exit;
End;
End;
If (Processor And PROC_X86_PENTIUM) <> 0 Then
Case bits Of
32 : Begin
tmp^.func := @ClearX86_32;
Exit;
End;
24 : ;
16 : Begin
tmp^.func := @ClearX86_16;
Exit;
End;
8 : Begin
tmp^.func := @ClearX86_8;
Exit;
End;
End;
{$ENDIF I386_ASSEMBLER}
Case bits Of
32 : Begin
tmp^.func := @ClearP_32;
Exit;
End;
24 : Begin
tmp^.func := @ClearP_24;
Exit;
End;
16 : Begin
tmp^.func := @ClearP_16;
Exit;
End;
8 : Begin
tmp^.func := @ClearP_8;
Exit;
End;
Else
Begin
free(tmp);
Hermes_Factory_getClearer := Nil;
End;
End;
End;
Function Hermes_Factory_getConverter(source, dest : PHermesFormat) : PHermesConverter;
Var
tmp : PHermesConverter;
i : Integer;
found : Boolean;
Begin
found := False;
tmp := malloc(SizeOf(THermesConverter));
If tmp = Nil Then
Begin
Hermes_Factory_getConverter := Nil;
Exit;
End;
{ Set all conversion routines to nil }
tmp^.loopnormal := Nil;
tmp^.loopstretch := Nil;
tmp^.normal := Nil;
tmp^.stretch := Nil;
tmp^.dither := Nil;
tmp^.ditherstretch := Nil;
tmp^.flags := 0;
If source^.indexed Then
{ For 8 bit indexed, just look at the destination bit depth and check
if the converter's processor is a subset of our processor }
For i := 0 To Factory_NumConverters - 1 Do
If (Factory_Converters[i].d_bits = dest^.bits) And
(Factory_Converters[i].s_idx And
((processor And Factory_Converters[i].processor) <> 0)) Then
Begin
{ If any routines are unassigned, assign them now }
If tmp^.loopnormal = Nil Then
Begin
tmp^.loopnormal := Factory_Converters[i].loopnormal;
found := True;
End;
If tmp^.normal = Nil Then
Begin
tmp^.normal := Factory_Converters[i].normal;
found := True;
End;
If tmp^.loopstretch = Nil Then
Begin
tmp^.loopstretch := Factory_Converters[i].loopstretch;
found := True;
End;
If tmp^.stretch = Nil Then
Begin
tmp^.stretch := Factory_Converters[i].stretch;
found := True;
End;
End Else
Else
{ Otherwise we need to compare everything, including bitmasks }
For i := 0 To Factory_NumConverters - 1 Do
If (Factory_Converters[i].d_bits = dest^.bits) And
(Factory_Converters[i].d_r = dest^.r) And
(Factory_Converters[i].d_g = dest^.g) And
(Factory_Converters[i].d_b = dest^.b) And
(Factory_Converters[i].d_a = dest^.a) And
(Factory_Converters[i].d_idx = dest^.indexed) And
(Factory_Converters[i].s_bits = source^.bits) And
(Factory_Converters[i].s_r = source^.r) And
(Factory_Converters[i].s_g = source^.g) And
(Factory_Converters[i].s_b = source^.b) And
(Factory_Converters[i].s_a = source^.a) And
(Factory_Converters[i].s_idx = source^.indexed) And
((processor And Factory_Converters[i].processor) <> 0) Then
Begin
{ If any routines are unassigned, assign them now }
If (tmp^.loopnormal = Nil) And
(Factory_Converters[i].loopnormal <> Nil) Then
Begin
tmp^.loopnormal := Factory_Converters[i].loopnormal;
found := True;
End;
If (tmp^.normal = Nil) And
(Factory_Converters[i].normal <> Nil) Then
Begin
tmp^.normal := Factory_Converters[i].normal;
found := True;
End;
If (tmp^.loopstretch = Nil) And
(Factory_Converters[i].loopstretch <> Nil) Then
Begin
tmp^.loopstretch := Factory_Converters[i].loopstretch;
found := True;
End;
If (tmp^.stretch = Nil) And
(Factory_Converters[i].stretch <> Nil) Then
Begin
tmp^.stretch := Factory_Converters[i].stretch;
found := True;
End;
If (tmp^.dither = Nil) And
(Factory_Converters[i].dither <> Nil) Then
Begin
tmp^.dither := Factory_Converters[i].dither;
found := True;
End;
If (tmp^.ditherstretch = Nil) And
(Factory_Converters[i].ditherstretch <> Nil) Then
Begin
tmp^.ditherstretch := Factory_Converters[i].ditherstretch;
found := True;
End;
{ In the rare event of having everything assigned, pull the emergency
break. Otherwise we need to continue looking (might be stretching
routines somewhere :)
Do I sound like a stewardess? }
If (tmp^.loopnormal <> Nil) And (tmp^.normal <> Nil) And
(tmp^.loopstretch <> Nil) And (tmp^.stretch <> Nil) And
(tmp^.dither <> Nil) And (tmp^.ditherstretch <> Nil) Then
Break;
End;
If found Then
Begin
Hermes_FormatCopy(source, @tmp^.source);
Hermes_FormatCopy(dest, @tmp^.dest);
Hermes_Factory_getConverter := tmp;
End
Else
Begin
free(tmp);
Hermes_Factory_getConverter := Nil;
End;
End;
Function Hermes_Factory_getEqualConverter(bits : Integer) : PHermesConverter;
Var
found : Boolean;
tmp : PHermesConverter;
asm_found : Integer;
c_found : Integer;
Begin
found := False;
tmp := malloc(SizeOf(THermesConverter));
If tmp = Nil Then
Begin
Hermes_Factory_getEqualConverter := Nil;
Exit;
End;
{ Set all conversion routines to null }
tmp^.loopnormal := Nil;
tmp^.loopstretch := Nil;
tmp^.normal := Nil;
tmp^.stretch := Nil;
tmp^.dither := Nil;
tmp^.ditherstretch := Nil;
{$IFDEF I386_ASSEMBLER}
{ Try MMX routines }
If (tmp^.loopnormal = Nil) Or (tmp^.normal = Nil) Or
(tmp^.loopstretch = Nil) Or (tmp^.stretch = Nil) Then
If (processor And PROC_MMX_PENTIUM) <> 0 Then
{ Case bits Of
End};
{ Try X86 routines }
If (tmp^.loopnormal = Nil) Or (tmp^.normal = Nil) Or
(tmp^.loopstretch = Nil) Or (tmp^.stretch = Nil) Then
If (processor And PROC_X86_PENTIUM) <> 0 Then
Begin
asm_found := 0;
Case bits Of
32 : Begin
tmp^.normal := @CopyX86p_4byte; asm_found := 1;
End;
24 : ;
16 : Begin
tmp^.normal := @CopyX86p_2byte; asm_found := 1;
End;
8 : Begin
tmp^.normal := @CopyX86p_1byte; asm_found := 1;
End;
End;
If (asm_found And 1) <> 0 Then
Begin
tmp^.loopnormal := @ConvertX86;
found := True;
End;
End;
{$ENDIF I386_ASSEMBLER}
If (tmp^.loopnormal = Nil) Or (tmp^.normal = Nil) Or
(tmp^.loopstretch = Nil) Or (tmp^.stretch = Nil) Then
Begin
c_found := 0;
Case bits Of
32 : Begin
If tmp^.normal = Nil Then
Begin
tmp^.normal := @CopyP_4byte; c_found := c_found Or 1;
End;
If tmp^.stretch = Nil Then
Begin
tmp^.stretch := @CopyP_4byte_S; c_found := c_found Or 2;
End;
End;
24 : Begin
If tmp^.normal = Nil Then
Begin
tmp^.normal := @CopyP_3byte; c_found := c_found Or 1;
End;
If tmp^.stretch = Nil Then
Begin
tmp^.stretch := @CopyP_3byte_S; c_found := c_found Or 2;
End;
End;
16 : Begin
If tmp^.normal = Nil Then
Begin
tmp^.normal := @CopyP_2byte; c_found := c_found Or 1;
End;
If tmp^.stretch = Nil Then
Begin
tmp^.stretch := @CopyP_2byte_S; c_found := c_found Or 2;
End;
End;
8 : Begin
If tmp^.normal = Nil Then
Begin
tmp^.normal := @CopyP_1byte; c_found := c_found Or 1;
End;
If tmp^.stretch = Nil Then
Begin
tmp^.stretch := @CopyP_1byte_S; c_found := c_found Or 2;
End;
End;
End;
If (c_found And 1) <> 0 Then
Begin
tmp^.loopnormal := @ConvertP; found := True;
End;
If (c_found And 2) <> 0 Then
Begin
tmp^.loopstretch := @ConvertPStretch; found := True;
End;
End;
If found Then
Hermes_Factory_getEqualConverter := tmp
Else
Begin
free(tmp);
Hermes_Factory_getEqualConverter := Nil;
End;
End;