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