1program convtest;
2
3{$MODE objfpc}
4
5{$I endian.inc}
6
7uses
8  SysUtils, ptc;
9
10const
11  destXSize = {480}320;
12  destYSize = {300}200;
13
14var
15  image: IPTCSurface;
16  surface: IPTCSurface;
17  format: IPTCFormat;
18  TestNum: Integer;
19
20function fb(q: Uint32): Integer;
21begin
22  fb := 0;
23  while (q and 1) = 0 do
24  begin
25    Inc(fb);
26    q := q shr 1;
27  end;
28end;
29
30function nb(q: Uint32): Integer;
31begin
32  nb := 0;
33  while q <> 0 do
34  begin
35    Inc(nb);
36    q := q and (q - 1);
37  end;
38end;
39
40procedure generic(src, dest: IPTCSurface);
41var
42  X, Y: Integer;
43  XSize, YSize: Integer;
44  r, g, b: Uint32;
45  pix: Uint32;
46  Psrc, Pdest: PUint8;
47  srcbits: Integer;
48  Srmask, Sgmask, Sbmask: Uint32;
49  Srmasknb, Sgmasknb, Sbmasknb: Integer;
50  Srmaskfb, Sgmaskfb, Sbmaskfb: Integer;
51  destbits: Integer;
52  Drmask, Dgmask, Dbmask: Uint32;
53  Drmasknb, Dgmasknb, Dbmasknb: Integer;
54  Drmaskfb, Dgmaskfb, Dbmaskfb: Integer;
55begin
56  XSize := dest.width;
57  YSize := dest.height;
58
59  srcbits := src.format.bits;
60  Srmask := src.format.r;
61  Sgmask := src.format.g;
62  Sbmask := src.format.b;
63  Srmasknb := nb(Srmask);
64  Sgmasknb := nb(Sgmask);
65  Sbmasknb := nb(Sbmask);
66  Srmaskfb := fb(Srmask);
67  Sgmaskfb := fb(Sgmask);
68  Sbmaskfb := fb(Sbmask);
69
70  destbits := dest.format.bits;
71  Drmask := dest.format.r;
72  Dgmask := dest.format.g;
73  Dbmask := dest.format.b;
74  Drmasknb := nb(Drmask);
75  Dgmasknb := nb(Dgmask);
76  Dbmasknb := nb(Dbmask);
77  Drmaskfb := fb(Drmask);
78  Dgmaskfb := fb(Dgmask);
79  Dbmaskfb := fb(Dbmask);
80
81{  Writeln(Srmasknb, ' ', Drmasknb);}
82
83  Psrc := src.lock;
84  try
85    Pdest := dest.lock;
86    try
87      for Y := 0 to YSize - 1 do
88        for X := 0 to XSize - 1 do
89        begin
90          case srcbits of
91            32: begin
92              pix := (PUint32(Psrc))^;
93              Inc(Psrc, 4);
94            end;
95            24: begin
96              {$IFDEF FPC_LITTLE_ENDIAN}
97                pix := (Psrc^) or ((Psrc + 1)^ shl 8) or ((Psrc + 2)^ shl 16);
98              {$ELSE FPC_LITTLE_ENDIAN}
99                pix := (Psrc^ shl 16) or ((Psrc + 1)^ shl 8) or ((Psrc + 2)^);
100              {$ENDIF FPC_LITTLE_ENDIAN}
101              Inc(Psrc, 3);
102            end;
103            16: begin
104              pix := (PUint16(Psrc))^;
105              Inc(Psrc, 2);
106            end;
107            8: begin
108              pix := Psrc^;
109              Inc(Psrc);
110            end;
111          end;
112
113          r := pix and Srmask;
114          g := pix and Sgmask;
115          b := pix and Sbmask;
116          r := r shr Srmaskfb;
117          g := g shr Sgmaskfb;
118          b := b shr Sbmaskfb;
119
120          if (Drmasknb - Srmasknb) >= 0 then
121            r := r shl (Drmasknb - Srmasknb)
122          else
123            r := r shr (Srmasknb - Drmasknb);
124          if (Dgmasknb - Sgmasknb) >= 0 then
125            g := g shl (Dgmasknb - Sgmasknb)
126          else
127            g := g shr (Sgmasknb - Dgmasknb);
128          if (Dbmasknb - Sbmasknb) >= 0 then
129            b := b shl (Dbmasknb - Sbmasknb)
130          else
131            b := b shr (Sbmasknb - Dbmasknb);
132
133          r := r shl Drmaskfb;
134          g := g shl Dgmaskfb;
135          b := b shl Dbmaskfb;
136          pix := r or g or b;
137
138          case destbits of
139            32: begin
140              (PUint32(Pdest))^ := pix;
141              Inc(Pdest, 4);
142            end;
143            24: begin
144              {$IFDEF FPC_LITTLE_ENDIAN}
145                Pdest^ := pix and $FF;
146                (Pdest + 1)^ := (pix shr 8) and $FF;
147                (Pdest + 2)^ := (pix shr 16) and $FF;
148              {$ELSE FPC_LITTLE_ENDIAN}
149                Pdest^ := (pix shr 16) and $FF;
150                (Pdest + 1)^ := (pix shr 8) and $FF;
151                (Pdest + 2)^ := pix and $FF;
152              {$ENDIF FPC_LITTLE_ENDIAN}
153              Inc(Pdest, 3);
154            end;
155            16: begin
156              (PUint16(Pdest))^ := pix;
157              Inc(Pdest, 2);
158            end;
159            8: begin
160              Pdest^ := pix;
161              Inc(Pdest);
162            end;
163          end;
164        end;
165    finally
166      dest.unlock;
167    end;
168  finally
169    src.unlock;
170  end;
171end;
172
173procedure test(sbits: Integer; sr, sg, sb: Uint32;
174               dbits: Integer; dr, dg, db: Uint32; da: Uint32 = 0;
175               dithering: Boolean = False);
176var
177  srcformat, destformat: IPTCFormat;
178  src, dest: IPTCSurface;
179  pixels: Pointer;
180  F: File;
181begin
182  Writeln(sbits, ' ', sr, ' ', sg, ' ', sb, ' ', dbits, ' ', dr, ' ', dg, ' ', db, ' ', da);
183  srcformat := TPTCFormatFactory.CreateNew(sbits, sr, sg, sb);
184  destformat := TPTCFormatFactory.CreateNew(dbits, dr, dg, db, da);
185  src := TPTCSurfaceFactory.CreateNew(320, 200, srcformat);
186  dest := TPTCSurfaceFactory.CreateNew(destXSize, destYSize, destformat);
187
188  if dithering then
189    dest.Option('attempt dithering');
190
191  generic(image, src);
192  src.copy(dest);
193{    generic(src, dest);}
194  generic(dest, surface);
195
196  Inc(TestNum);
197  AssignFile(F, 'test' + IntToStr(TestNum) + '.raw');
198  Rewrite(F, 1);
199  try
200    pixels := surface.lock;
201    try
202      BlockWrite(F, pixels^, surface.height * surface.pitch);
203    finally
204      surface.unlock;
205    end;
206  finally
207    CloseFile(F);
208  end;
209end;
210
211procedure load(surface: IPTCSurface; filename: String);
212var
213  F: File;
214  width, height: Integer;
215  pixels: PByte;
216  y: Integer;
217begin
218  AssignFile(F, filename);
219  Reset(F, 1);
220  try
221    Seek(F, 18);
222    width := surface.width;
223    height := surface.height;
224    pixels := surface.lock;
225    try
226      for y := height - 1 downto 0 do
227        BlockRead(F, pixels[width * y * 3], width * 3);
228    finally
229      surface.unlock;
230    end;
231  finally
232    CloseFile(F);
233  end;
234end;
235
236begin
237  TestNum := 0;
238  try
239    {$IFDEF FPC_LITTLE_ENDIAN}
240    format := TPTCFormatFactory.CreateNew(24, $00FF0000, $0000FF00, $000000FF);
241    {$ELSE FPC_LITTLE_ENDIAN}
242    format := TPTCFormatFactory.CreateNew(24, $000000FF, $0000FF00, $00FF0000);
243    {$ENDIF FPC_LITTLE_ENDIAN}
244    surface := TPTCSurfaceFactory.CreateNew(destXSize, destYSize, format);
245
246    image := TPTCSurfaceFactory.CreateNew(320, 200, format);
247    load(image, '../examples/image.tga');
248
249
250    Writeln('testing equal converters');
251    {test equal converters}
252    test(32, $00FF0000, $0000FF00, $000000FF, 32, $00FF0000, $0000FF00, $000000FF); { 1 }
253    test(24, $FF0000, $00FF00, $0000FF, 24, $FF0000, $00FF00, $0000FF);             { 2 }
254    test(16, $F800, $07E0, $001F, 16, $F800,$07E0, $001F);                          { 3 }
255    test( 8, $E0, $1C, $03, 8, $E0, $1C, $03);                                      { 4 }
256
257    Writeln('testing generic converters');
258    {test generic}
259    test(32, $FF000000, $000000FF, $000FF000, 32, $000FF000, $0FF00000, $000000FF); { 5 }
260    test(32, $FF000000, $000000FF, $000FF000, 24, $00FF00, $FF0000, $000000FF);     { 6 }
261    test(32, $FF000000, $000000FF, $000FF000, 16, $F000, $0F00, $00F0);             { 7 }
262    test(32, $FF000000, $000000FF, $000FF000, 8, $0C, $03, $F0);                    { 8 }
263    test(24, $FF0000, $0000FF, $00FF00, 32, $000FF000, $0FF00000, $000000FF);       { 9 }
264    test(24, $FF0000, $0000FF, $00FF00, 24, $00FF00, $FF0000, $000000FF);           { 10 }
265    test(24, $FF0000, $0000FF, $00FF00, 16, $F000, $0F00, $00F0);                   { 11 }
266    test(24, $FF0000, $0000FF, $00FF00, 8, $0C, $03, $F0);                          { 12 }
267    test(16, $001F, $F800, $07E0, 32, $000FF000, $0FF00000, $000000FF);             { 13 }
268    test(16, $001F, $F800, $07E0, 24, $00FF00, $FF0000, $000000FF);                 { 14 }
269    test(16, $001F, $F800, $07E0, 16, $F000, $0F00, $00F0);                         { 15 }
270    test(16, $001F, $F800, $07E0, 8, $0C, $03, $F0);                                { 16 }
271//    test(8, $03, $E0, $1C, 32, $000FF000, $0FF00000, $000000FF); {unsupported}
272//    test(8, $03, $E0, $1C, 24, $00FF00, $FF0000, $000000FF); {unsupported}
273//    test(8, $03, $E0, $1C, 16, $F000, $0F00, $00F0); {unsupported}
274//    test(8, $03, $E0, $1C, 8, $0C, $03, $F0); {unsupported}
275
276    Writeln('testing specialized converters');
277    {From 32 bit RGB 888}
278    test(32,$ff0000,$ff00,$ff,16,$f800,$7e0,$1f);                { 16RGB565  }      { 17 }
279    test(32,$ff0000,$ff00,$ff, 8,$e0,$1c,$3);                    { 8RGB332   }      { 18 }
280    test(32,$ff0000,$ff00,$ff,16,$7c00,$3e0,$1f);                { 16RGB555  }      { 19 }
281    test(32,$ff0000,$ff00,$ff,24,$ff0000,$ff00,$ff);             { 24RGB888  }      { 20 }
282    test(32,$ff0000,$ff00,$ff,32,$ff,$ff00,$ff0000);             { 32BGR888  }      { 21 }
283    test(32,$ff0000,$ff00,$ff,16,$1f,$7e0,$f800);                { 16BGR565  }      { 22 }
284    test(32,$ff0000,$ff00,$ff,16,$1f,$3e0,$7c00);                { 16BGR555  }      { 23 }
285    test(32,$ff0000,$ff00,$ff,32,$ff000000,$ff0000,$ff00,$ff);   { 32RGBA888 }      { 24 }
286    test(32,$ff0000,$ff00,$ff,32,$ff00,$ff0000,$ff000000,$ff);   { 32BGRA888 }      { 25 }
287    test(32,$ff0000,$ff00,$ff,24,$ff,$ff00,$ff0000);             { 24BGR888  }      { 26 }
288    {From 24 bit RGB 888}
289    test(24,$ff0000,$ff00,$ff,32,$ff0000,$ff00,$ff);             { 32RGB888  }      { 27 }
290    test(24,$ff0000,$ff00,$ff,16,$f800,$7e0,$1f);                { 16RGB565  }      { 28 }
291    test(24,$ff0000,$ff00,$ff, 8,$e0,$1c,$3);                    { 8RGB332   }      { 29 }
292    test(24,$ff0000,$ff00,$ff,16,$7c00,$3e0,$1f);                { 16RGB555  }      { 30 }
293    test(24,$ff0000,$ff00,$ff,32,$ff,$ff00,$ff0000);             { 32BGR888  }      { 31 }
294    test(24,$ff0000,$ff00,$ff,16,$1f,$7e0,$f800);                { 16BGR565  }      { 32 }
295    test(24,$ff0000,$ff00,$ff,16,$1f,$3e0,$7c00);                { 16BGR555  }      { 33 }
296    test(24,$ff0000,$ff00,$ff,32,$ff000000,$ff0000,$ff00,$ff);   { 32RGBA888 }      { 34 }
297    test(24,$ff0000,$ff00,$ff,32,$ff00,$ff0000,$ff000000,$ff);   { 32BGRA888 }      { 35 }
298    test(24,$ff0000,$ff00,$ff,24,$ff,$ff00,$ff0000);             { 24BGR888  }      { 36 }
299    {From 16 bit RGB 565}
300    test(16,$f800,$7e0,$1f,32,$ff0000,$ff00,$ff);                { 32RGB888  }      { 37 }
301    test(16,$f800,$7e0,$1f, 8,$e0,$1c,$3);                       { 8RGB332   }      { 38 }
302    test(16,$f800,$7e0,$1f,16,$7c00,$3e0,$1f);                   { 16RGB555  }      { 39 }
303    test(16,$f800,$7e0,$1f,24,$ff0000,$ff00,$ff);                { 24RGB888  }      { 40 }
304    test(16,$f800,$7e0,$1f,32,$ff,$ff00,$ff0000);                { 32BGR888  }      { 41 }
305    test(16,$f800,$7e0,$1f,16,$1f,$7e0,$f800);                   { 16BGR565  }      { 42 }
306    test(16,$f800,$7e0,$1f,16,$1f,$3e0,$7c00);                   { 16BGR555  }      { 43 }
307    test(16,$f800,$7e0,$1f,32,$ff000000,$ff0000,$ff00,$ff);      { 32RGBA888 }      { 44 }
308    test(16,$f800,$7e0,$1f,32,$ff00,$ff0000,$ff000000,$ff);      { 32BGRA888 }      { 45 }
309    test(16,$f800,$7e0,$1f,24,$ff,$ff00,$ff0000);                { 24BGR888  }      { 46 }
310    {From 32 bit muhmu}
311    test(32,$ff00000,$3fc00,$ff,32,$ff0000,$ff00,$ff);           { 32RGB888  }      { 47 }
312    test(32,$ff00000,$3fc00,$ff,16,$f800,$7e0,$1f);              { 16RGB565  }      { 48 }
313    test(32,$ff00000,$3fc00,$ff, 8,$e0,$1c,$3);                  { 8RGB332   }      { 49 }
314    test(32,$ff00000,$3fc00,$ff,16,$7c00,$3e0,$1f);              { 16RGB555  }      { 50 }
315    test(32,$ff00000,$3fc00,$ff,24,$ff0000,$ff00,$ff);           { 24RGB888  }      { 51 }
316    test(32,$ff00000,$3fc00,$ff,32,$ff,$ff00,$ff0000);           { 32BGR888  }      { 52 }
317    test(32,$ff00000,$3fc00,$ff,16,$1f,$7e0,$f800);              { 16BGR565  }      { 53 }
318    test(32,$ff00000,$3fc00,$ff,16,$1f,$3e0,$7c00);              { 16BGR555  }      { 54 }
319    test(32,$ff00000,$3fc00,$ff,32,$ff000000,$ff0000,$ff00,$ff); { 32RGBA888 }      { 55 }
320    test(32,$ff00000,$3fc00,$ff,32,$ff00,$ff0000,$ff000000,$ff); { 32BGRA888 }      { 56 }
321    test(32,$ff00000,$3fc00,$ff,24,$ff,$ff00,$ff0000);           { 24BGR888  }      { 57 }
322
323    Writeln('testing dithering converters');
324    test(32,$ff0000,$ff00,$ff,16,$f800,$7e0,$1f, 0, True);       { 16RGB565  }      { 58 }
325    test(32,$ff0000,$ff00,$ff, 8,$e0,$1c,$3, 0 , True);          { 8RGB332   }      { 59 }
326  except
327    on error: TPTCError do
328      error.report;
329  end;
330end.
331