src/lib/vampimg/JpegLib/imjcmarker.pas

   1 unit imjcmarker;
   2
   3 { This file contains routines to write JPEG datastream markers. }
   4
   5 { Original: jcmarker.c; Copyright (C) 1991-1998, Thomas G. Lane. }
   6
   7 interface
   8
   9 {$I imjconfig.inc}
  10
  11 uses
  12   imjinclude, imjmorecfg, imjerror,
  13   imjdeferr, imjpeglib, imjutils;
  14
  15
  16 const
  17                 { JPEG marker codes }
  18   M_SOF0  = $c0;
  19   M_SOF1  = $c1;
  20   M_SOF2  = $c2;
  21   M_SOF3  = $c3;
  22
  23   M_SOF5  = $c5;
  24   M_SOF6  = $c6;
  25   M_SOF7  = $c7;
  26
  27   M_JPG   = $c8;
  28   M_SOF9  = $c9;
  29   M_SOF10 = $ca;
  30   M_SOF11 = $cb;
  31
  32   M_SOF13 = $cd;
  33   M_SOF14 = $ce;
  34   M_SOF15 = $cf;
  35
  36   M_DHT   = $c4;
  37
  38   M_DAC   = $cc;
  39
  40   M_RST0  = $d0;
  41   M_RST1  = $d1;
  42   M_RST2  = $d2;
  43   M_RST3  = $d3;
  44   M_RST4  = $d4;
  45   M_RST5  = $d5;
  46   M_RST6  = $d6;
  47   M_RST7  = $d7;
  48
  49   M_SOI   = $d8;
  50   M_EOI   = $d9;
  51   M_SOS   = $da;
  52   M_DQT   = $db;
  53   M_DNL   = $dc;
  54   M_DRI   = $dd;
  55   M_DHP   = $de;
  56   M_EXP   = $df;
  57
  58   M_APP0  = $e0;
  59   M_APP1  = $e1;
  60   M_APP2  = $e2;
  61   M_APP3  = $e3;
  62   M_APP4  = $e4;
  63   M_APP5  = $e5;
  64   M_APP6  = $e6;
  65   M_APP7  = $e7;
  66   M_APP8  = $e8;
  67   M_APP9  = $e9;
  68   M_APP10 = $ea;
  69   M_APP11 = $eb;
  70   M_APP12 = $ec;
  71   M_APP13 = $ed;
  72   M_APP14 = $ee;
  73   M_APP15 = $ef;
  74
  75   M_JPG0  = $f0;
  76   M_JPG13 = $fd;
  77   M_COM   = $fe;
  78
  79   M_TEM   = $01;
  80
  81   M_ERROR = $100;
  82
  83 type
  84   JPEG_MARKER = Word;
  85
  86 { Private state }
  87
  88 type
  89   my_marker_ptr = ^my_marker_writer;
  90   my_marker_writer = record
  91     pub : jpeg_marker_writer; { public fields }
  92
  93     last_restart_interval : uint; { last DRI value emitted; 0 after SOI }
  94   end;
  95
  96
  97
  98
  99 {GLOBAL}
 100 procedure jinit_marker_writer (cinfo : j_compress_ptr);
 101
 102 implementation
 103
 104 { Basic output routines.
 105
 106   Note that we do not support suspension while writing a marker.
 107   Therefore, an application using suspension must ensure that there is
 108   enough buffer space for the initial markers (typ. 600-700 bytes) before
 109   calling jpeg_start_compress, and enough space to write the trailing EOI
 110   (a few bytes) before calling jpeg_finish_compress.  Multipass compression
 111   modes are not supported at all with suspension, so those two are the only
 112   points where markers will be written. }
 113
 114
 115 {LOCAL}
 116 procedure emit_byte (cinfo : j_compress_ptr; val : int);
 117 { Emit a byte }
 118 var
 119   dest : jpeg_destination_mgr_ptr;
 120 begin
 121   dest := cinfo^.dest;
 122
 123   dest^.next_output_byte^ := JOCTET(val);
 124   Inc(dest^.next_output_byte);
 125
 126   Dec(dest^.free_in_buffer);
 127   if (dest^.free_in_buffer = 0) then
 128   begin
 129     if not dest^.empty_output_buffer(cinfo) then
 130       ERREXIT(j_common_ptr(cinfo), JERR_CANT_SUSPEND);
 131   end;
 132 end;
 133
 134
 135 {LOCAL}
 136 procedure emit_marker(cinfo : j_compress_ptr; mark : JPEG_MARKER);
 137 { Emit a marker code }
 138 begin
 139   emit_byte(cinfo, $FF);
 140   emit_byte(cinfo, int(mark));
 141 end;
 142
 143
 144 {LOCAL}
 145 procedure emit_2bytes (cinfo : j_compress_ptr; value : int);
 146 { Emit a 2-byte integer; these are always MSB first in JPEG files }
 147 begin
 148   emit_byte(cinfo, (value shr 8) and $FF);
 149   emit_byte(cinfo, value and $FF);
 150 end;
 151
 152
 153 { Routines to write specific marker types. }
 154
 155 {LOCAL}
 156 function emit_dqt (cinfo : j_compress_ptr; index : int) : int;
 157 { Emit a DQT marker }
 158 { Returns the precision used (0 = 8bits, 1 = 16bits) for baseline checking }
 159 var
 160   qtbl : JQUANT_TBL_PTR;
 161   prec : int;
 162   i : int;
 163 var
 164   qval : uint;
 165 begin
 166   qtbl := cinfo^.quant_tbl_ptrs[index];
 167   if (qtbl = NIL) then
 168     ERREXIT1(j_common_ptr(cinfo), JERR_NO_QUANT_TABLE, index);
 169
 170   prec := 0;
 171   for i := 0 to Pred(DCTSIZE2) do
 172   begin
 173     if (qtbl^.quantval[i] > 255) then
 174       prec := 1;
 175   end;
 176
 177   if not qtbl^.sent_table then
 178   begin
 179     emit_marker(cinfo, M_DQT);
 180
 181     if (prec <> 0) then
 182       emit_2bytes(cinfo, DCTSIZE2*2 + 1 + 2)
 183     else
 184       emit_2bytes(cinfo, DCTSIZE2 + 1 + 2);
 185
 186     emit_byte(cinfo, index + (prec shl 4));
 187
 188     for i := 0 to Pred(DCTSIZE2) do
 189     begin
 190       { The table entries must be emitted in zigzag order. }
 191       qval := qtbl^.quantval[jpeg_natural_order[i]];
 192       if (prec <> 0) then
 193   emit_byte(cinfo, int(qval shr 8));
 194       emit_byte(cinfo, int(qval and $FF));
 195     end;
 196
 197     qtbl^.sent_table := TRUE;
 198   end;
 199
 200   emit_dqt := prec;
 201 end;
 202
 203
 204 {LOCAL}
 205 procedure emit_dht (cinfo : j_compress_ptr; index : int; is_ac : boolean);
 206 { Emit a DHT marker }
 207 var
 208   htbl : JHUFF_TBL_PTR;
 209   length, i : int;
 210 begin
 211   if (is_ac) then
 212   begin
 213     htbl := cinfo^.ac_huff_tbl_ptrs[index];
 214     index := index + $10;                { output index has AC bit set }
 215   end
 216   else
 217   begin
 218     htbl := cinfo^.dc_huff_tbl_ptrs[index];
 219   end;
 220
 221   if (htbl = NIL) then
 222     ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, index);
 223
 224   if not htbl^.sent_table then
 225   begin
 226     emit_marker(cinfo, M_DHT);
 227
 228     length := 0;
 229     for i := 1 to 16 do
 230       length := length + htbl^.bits[i];
 231
 232     emit_2bytes(cinfo, length + 2 + 1 + 16);
 233     emit_byte(cinfo, index);
 234
 235     for i := 1 to 16 do
 236       emit_byte(cinfo, htbl^.bits[i]);
 237
 238     for i := 0 to Pred(length) do
 239       emit_byte(cinfo, htbl^.huffval[i]);
 240
 241     htbl^.sent_table := TRUE;
 242   end;
 243 end;
 244
 245
 246 {LOCAL}
 247 procedure emit_dac (cinfo : j_compress_ptr);
 248 { Emit a DAC marker }
 249 { Since the useful info is so small, we want to emit all the tables in }
 250 { one DAC marker.  Therefore this routine does its own scan of the table. }
 251 {$ifdef C_ARITH_CODING_SUPPORTED}
 252 var
 253   dc_in_use : array[0..NUM_ARITH_TBLS] of byte;
 254   ac_in_use : array[0..NUM_ARITH_TBLS] of byte;
 255   length, i : int;
 256   compptr : jpeg_component_info_ptr;
 257 begin
 258   for i := 0 to pred(NUM_ARITH_TBLS) do
 259   begin
 260     dc_in_use[i] := 0;
 261     ac_in_use[i] := 0;
 262   end;
 263
 264   for i := 0 to pred(cinfo^.comps_in_scan) do
 265   begin
 266     compptr := cinfo^.cur_comp_info[i];
 267     dc_in_use[compptr^.dc_tbl_no] := 1;
 268     ac_in_use[compptr^.ac_tbl_no] := 1;
 269   end;
 270
 271   length := 0;
 272   for i := 0 to pred(NUM_ARITH_TBLS) do
 273     Inc(length, dc_in_use[i] + ac_in_use[i]);
 274
 275   emit_marker(cinfo, M_DAC);
 276
 277   emit_2bytes(cinfo, length*2 + 2);
 278
 279   for i := 0 to pred(NUM_ARITH_TBLS) do
 280   begin
 281     if (dc_in_use[i] <> 0) then
 282     begin
 283       emit_byte(cinfo, i);
 284       emit_byte(cinfo, cinfo^.arith_dc_L[i] + (cinfo^.arith_dc_U[i] shl 4));
 285     end;
 286     if (ac_in_use[i] <> 0) then
 287     begin
 288       emit_byte(cinfo, i + $10);
 289       emit_byte(cinfo, cinfo^.arith_ac_K[i]);
 290     end;
 291   end;
 292 end;
 293 {$else}
 294 begin
 295 end;
 296 {$endif}  {C_ARITH_CODING_SUPPORTED}
 297
 298
 299 {LOCAL}
 300 procedure emit_dri (cinfo : j_compress_ptr);
 301 { Emit a DRI marker }
 302 begin
 303   emit_marker(cinfo, M_DRI);
 304
 305   emit_2bytes(cinfo, 4);  { fixed length }
 306
 307   emit_2bytes(cinfo, int(cinfo^.restart_interval));
 308 end;
 309
 310
 311 {LOCAL}
 312 procedure emit_sof (cinfo : j_compress_ptr; code : JPEG_MARKER);
 313 { Emit a SOF marker }
 314 var
 315   ci : int;
 316   compptr : jpeg_component_info_ptr;
 317 begin
 318   emit_marker(cinfo, code);
 319
 320   emit_2bytes(cinfo, 3 * cinfo^.num_components + 2 + 5 + 1); { length }
 321
 322   { Make sure image isn't bigger than SOF field can handle }
 323   if (long(cinfo^.image_height) > long(65535)) or
 324      (long(cinfo^.image_width) > long(65535)) then
 325     ERREXIT1(j_common_ptr(cinfo), JERR_IMAGE_TOO_BIG, uInt(65535));
 326
 327   emit_byte(cinfo, cinfo^.data_precision);
 328   emit_2bytes(cinfo, int(cinfo^.image_height));
 329   emit_2bytes(cinfo, int(cinfo^.image_width));
 330
 331   emit_byte(cinfo, cinfo^.num_components);
 332
 333   compptr := jpeg_component_info_ptr(cinfo^.comp_info);
 334   for ci := 0  to Pred(cinfo^.num_components) do
 335   begin
 336     emit_byte(cinfo, compptr^.component_id);
 337     emit_byte(cinfo, (compptr^.h_samp_factor shl 4) + compptr^.v_samp_factor);
 338     emit_byte(cinfo, compptr^.quant_tbl_no);
 339     Inc(compptr);
 340   end;
 341 end;
 342
 343
 344 {LOCAL}
 345 procedure emit_sos (cinfo : j_compress_ptr);
 346 { Emit a SOS marker }
 347 var
 348   i, td, ta : int;
 349   compptr : jpeg_component_info_ptr;
 350 begin
 351   emit_marker(cinfo, M_SOS);
 352
 353   emit_2bytes(cinfo, 2 * cinfo^.comps_in_scan + 2 + 1 + 3); { length }
 354
 355   emit_byte(cinfo, cinfo^.comps_in_scan);
 356
 357   for i := 0 to Pred(cinfo^.comps_in_scan) do
 358   begin
 359     compptr := cinfo^.cur_comp_info[i];
 360     emit_byte(cinfo, compptr^.component_id);
 361     td := compptr^.dc_tbl_no;
 362     ta := compptr^.ac_tbl_no;
 363     if (cinfo^.progressive_mode) then
 364     begin
 365       { Progressive mode: only DC or only AC tables are used in one scan;
 366         furthermore, Huffman coding of DC refinement uses no table at all.
 367         We emit 0 for unused field(s); this is recommended by the P&M text
 368         but does not seem to be specified in the standard. }
 369
 370       if (cinfo^.Ss = 0) then
 371       begin
 372   ta := 0;                { DC scan }
 373   if (cinfo^.Ah <> 0) and not cinfo^.arith_code then
 374     td := 0;              { no DC table either }
 375       end
 376       else
 377       begin
 378   td := 0;      { AC scan }
 379       end;
 380     end;
 381     emit_byte(cinfo, (td shl 4) + ta);
 382   end;
 383
 384   emit_byte(cinfo, cinfo^.Ss);
 385   emit_byte(cinfo, cinfo^.Se);
 386   emit_byte(cinfo, (cinfo^.Ah shl 4) + cinfo^.Al);
 387 end;
 388
 389
 390 {LOCAL}
 391 procedure emit_jfif_app0 (cinfo : j_compress_ptr);
 392 { Emit a JFIF-compliant APP0 marker }
 393 {
 394  Length of APP0 block (2 bytes)
 395  Block ID     (4 bytes - ASCII "JFIF")
 396  Zero byte      (1 byte to terminate the ID string)
 397  Version Major, Minor   (2 bytes - major first)
 398  Units      (1 byte - $00 = none, $01 = inch, $02 = cm)
 399  Xdpu     (2 bytes - dots per unit horizontal)
 400  Ydpu     (2 bytes - dots per unit vertical)
 401  Thumbnail X size   (1 byte)
 402  Thumbnail Y size   (1 byte)
 403 }
 404 begin
 405   emit_marker(cinfo, M_APP0);
 406
 407   emit_2bytes(cinfo, 2 + 4 + 1 + 2 + 1 + 2 + 2 + 1 + 1); { length }
 408
 409   emit_byte(cinfo, $4A);  { Identifier: ASCII "JFIF" }
 410   emit_byte(cinfo, $46);
 411   emit_byte(cinfo, $49);
 412   emit_byte(cinfo, $46);
 413   emit_byte(cinfo, 0);
 414   emit_byte(cinfo, cinfo^.JFIF_major_version); { Version fields }
 415   emit_byte(cinfo, cinfo^.JFIF_minor_version);
 416   emit_byte(cinfo, cinfo^.density_unit); { Pixel size information }
 417   emit_2bytes(cinfo, int(cinfo^.X_density));
 418   emit_2bytes(cinfo, int(cinfo^.Y_density));
 419   emit_byte(cinfo, 0);    { No thumbnail image }
 420   emit_byte(cinfo, 0);
 421 end;
 422
 423
 424 {LOCAL}
 425 procedure emit_adobe_app14 (cinfo : j_compress_ptr);
 426 { Emit an Adobe APP14 marker }
 427 {
 428   Length of APP14 block (2 bytes)
 429   Block ID      (5 bytes - ASCII "Adobe")
 430   Version Number    (2 bytes - currently 100)
 431   Flags0      (2 bytes - currently 0)
 432   Flags1      (2 bytes - currently 0)
 433   Color transform   (1 byte)
 434
 435   Although Adobe TN 5116 mentions Version = 101, all the Adobe files
 436   now in circulation seem to use Version = 100, so that's what we write.
 437
 438   We write the color transform byte as 1 if the JPEG color space is
 439   YCbCr, 2 if it's YCCK, 0 otherwise.  Adobe's definition has to do with
 440   whether the encoder performed a transformation, which is pretty useless.
 441 }
 442 begin
 443   emit_marker(cinfo, M_APP14);
 444
 445   emit_2bytes(cinfo, 2 + 5 + 2 + 2 + 2 + 1); { length }
 446
 447   emit_byte(cinfo, $41);  { Identifier: ASCII "Adobe" }
 448   emit_byte(cinfo, $64);
 449   emit_byte(cinfo, $6F);
 450   emit_byte(cinfo, $62);
 451   emit_byte(cinfo, $65);
 452   emit_2bytes(cinfo, 100);  { Version }
 453   emit_2bytes(cinfo, 0);  { Flags0 }
 454   emit_2bytes(cinfo, 0);  { Flags1 }
 455   case (cinfo^.jpeg_color_space) of
 456   JCS_YCbCr:
 457     emit_byte(cinfo, 1);  { Color transform = 1 }
 458   JCS_YCCK:
 459     emit_byte(cinfo, 2);  { Color transform = 2 }
 460   else
 461     emit_byte(cinfo, 0);  { Color transform = 0 }
 462   end;
 463 end;
 464
 465
 466 { These routines allow writing an arbitrary marker with parameters.
 467   The only intended use is to emit COM or APPn markers after calling
 468   write_file_header and before calling write_frame_header.
 469   Other uses are not guaranteed to produce desirable results.
 470   Counting the parameter bytes properly is the caller's responsibility. }
 471
 472 {METHODDEF}
 473 procedure write_marker_header (cinfo : j_compress_ptr;
 474                                marker : int;
 475                                datalen : uint);
 476 { Emit an arbitrary marker header }
 477 begin
 478   if (datalen > uint(65533)) then  { safety check }
 479     ERREXIT(j_common_ptr(cinfo), JERR_BAD_LENGTH);
 480
 481   emit_marker(cinfo, JPEG_MARKER(marker));
 482
 483   emit_2bytes(cinfo, int(datalen + 2)); { total length }
 484 end;
 485
 486 {METHODDEF}
 487 procedure write_marker_byte (cinfo : j_compress_ptr; val : int);
 488 { Emit one byte of marker parameters following write_marker_header }
 489 begin
 490   emit_byte(cinfo, val);
 491 end;
 492
 493 { Write datastream header.
 494   This consists of an SOI and optional APPn markers.
 495   We recommend use of the JFIF marker, but not the Adobe marker,
 496   when using YCbCr or grayscale data.  The JFIF marker should NOT
 497   be used for any other JPEG colorspace.  The Adobe marker is helpful
 498   to distinguish RGB, CMYK, and YCCK colorspaces.
 499   Note that an application can write additional header markers after
 500   jpeg_start_compress returns. }
 501
 502
 503 {METHODDEF}
 504 procedure write_file_header (cinfo : j_compress_ptr);
 505 var
 506   marker : my_marker_ptr;
 507 begin
 508   marker := my_marker_ptr(cinfo^.marker);
 509
 510   emit_marker(cinfo, M_SOI);   { first the SOI }
 511
 512   { SOI is defined to reset restart interval to 0 }
 513   marker^.last_restart_interval := 0;
 514
 515   if (cinfo^.write_JFIF_header) then { next an optional JFIF APP0 }
 516     emit_jfif_app0(cinfo);
 517   if (cinfo^.write_Adobe_marker) then { next an optional Adobe APP14 }
 518     emit_adobe_app14(cinfo);
 519 end;
 520
 521
 522 { Write frame header.
 523   This consists of DQT and SOFn markers.
 524   Note that we do not emit the SOF until we have emitted the DQT(s).
 525   This avoids compatibility problems with incorrect implementations that
 526   try to error-check the quant table numbers as soon as they see the SOF. }
 527
 528
 529 {METHODDEF}
 530 procedure write_frame_header (cinfo : j_compress_ptr);
 531 var
 532   ci, prec : int;
 533   is_baseline : boolean;
 534   compptr : jpeg_component_info_ptr;
 535 begin
 536   { Emit DQT for each quantization table.
 537     Note that emit_dqt() suppresses any duplicate tables. }
 538
 539   prec := 0;
 540   compptr := jpeg_component_info_ptr(cinfo^.comp_info);
 541   for ci := 0 to Pred(cinfo^.num_components) do
 542   begin
 543     prec := prec + emit_dqt(cinfo, compptr^.quant_tbl_no);
 544     Inc(compptr);
 545   end;
 546   { now prec is nonzero iff there are any 16-bit quant tables. }
 547
 548   { Check for a non-baseline specification.
 549     Note we assume that Huffman table numbers won't be changed later. }
 550
 551   if (cinfo^.arith_code) or (cinfo^.progressive_mode)
 552    or (cinfo^.data_precision <> 8) then
 553   begin
 554     is_baseline := FALSE;
 555   end
 556   else
 557   begin
 558     is_baseline := TRUE;
 559     compptr := jpeg_component_info_ptr(cinfo^.comp_info);
 560     for ci := 0 to Pred(cinfo^.num_components) do
 561     begin
 562       if (compptr^.dc_tbl_no > 1) or (compptr^.ac_tbl_no > 1) then
 563   is_baseline := FALSE;
 564       Inc(compptr);
 565     end;
 566     if (prec <> 0) and (is_baseline) then
 567     begin
 568       is_baseline := FALSE;
 569       { If it's baseline except for quantizer size, warn the user }
 570       {$IFDEF DEBUG}
 571       TRACEMS(j_common_ptr(cinfo), 0, JTRC_16BIT_TABLES);
 572       {$ENDIF}
 573     end;
 574   end;
 575
 576   { Emit the proper SOF marker }
 577   if (cinfo^.arith_code) then
 578   begin
 579     emit_sof(cinfo, M_SOF9);  { SOF code for arithmetic coding }
 580   end
 581   else
 582   begin
 583     if (cinfo^.progressive_mode) then
 584       emit_sof(cinfo, M_SOF2) { SOF code for progressive Huffman }
 585     else if (is_baseline) then
 586       emit_sof(cinfo, M_SOF0) { SOF code for baseline implementation }
 587     else
 588       emit_sof(cinfo, M_SOF1);  { SOF code for non-baseline Huffman file }
 589   end;
 590 end;
 591
 592
 593 { Write scan header.
 594   This consists of DHT or DAC markers, optional DRI, and SOS.
 595   Compressed data will be written following the SOS. }
 596
 597 {METHODDEF}
 598 procedure write_scan_header (cinfo : j_compress_ptr);
 599 var
 600   marker : my_marker_ptr;
 601   i : int;
 602   compptr : jpeg_component_info_ptr;
 603 begin
 604   marker := my_marker_ptr(cinfo^.marker);
 605   if (cinfo^.arith_code) then
 606   begin
 607     { Emit arith conditioning info.  We may have some duplication
 608       if the file has multiple scans, but it's so small it's hardly
 609       worth worrying about. }
 610     emit_dac(cinfo);
 611   end
 612   else
 613   begin
 614     { Emit Huffman tables.
 615       Note that emit_dht() suppresses any duplicate tables. }
 616     for i := 0 to Pred(cinfo^.comps_in_scan) do
 617     begin
 618       compptr := cinfo^.cur_comp_info[i];
 619       if (cinfo^.progressive_mode) then
 620       begin
 621   { Progressive mode: only DC or only AC tables are used in one scan }
 622   if (cinfo^.Ss = 0) then
 623         begin
 624     if (cinfo^.Ah = 0) then  { DC needs no table for refinement scan }
 625       emit_dht(cinfo, compptr^.dc_tbl_no, FALSE);
 626   end
 627         else
 628         begin
 629     emit_dht(cinfo, compptr^.ac_tbl_no, TRUE);
 630   end;
 631       end
 632       else
 633       begin
 634   { Sequential mode: need both DC and AC tables }
 635   emit_dht(cinfo, compptr^.dc_tbl_no, FALSE);
 636   emit_dht(cinfo, compptr^.ac_tbl_no, TRUE);
 637       end;
 638     end;
 639   end;
 640
 641   { Emit DRI if required --- note that DRI value could change for each scan.
 642     We avoid wasting space with unnecessary DRIs, however. }
 643
 644   if (cinfo^.restart_interval <> marker^.last_restart_interval) then
 645   begin
 646     emit_dri(cinfo);
 647     marker^.last_restart_interval := cinfo^.restart_interval;
 648   end;
 649
 650   emit_sos(cinfo);
 651 end;
 652
 653
 654
 655 { Write datastream trailer. }
 656
 657
 658 {METHODDEF}
 659 procedure write_file_trailer (cinfo : j_compress_ptr);
 660 begin
 661   emit_marker(cinfo, M_EOI);
 662 end;
 663
 664
 665 { Write an abbreviated table-specification datastream.
 666   This consists of SOI, DQT and DHT tables, and EOI.
 667   Any table that is defined and not marked sent_table = TRUE will be
 668   emitted.  Note that all tables will be marked sent_table = TRUE at exit. }
 669
 670
 671 {METHODDEF}
 672 procedure write_tables_only (cinfo : j_compress_ptr);
 673 var
 674   i : int;
 675 begin
 676   emit_marker(cinfo, M_SOI);
 677
 678   for i := 0 to Pred(NUM_QUANT_TBLS) do
 679   begin
 680     if (cinfo^.quant_tbl_ptrs[i] <> NIL) then
 681       emit_dqt(cinfo, i);  { dummy := ... }
 682   end;
 683
 684   if (not cinfo^.arith_code) then
 685   begin
 686     for i := 0 to Pred(NUM_HUFF_TBLS) do
 687     begin
 688       if (cinfo^.dc_huff_tbl_ptrs[i] <> NIL) then
 689   emit_dht(cinfo, i, FALSE);
 690       if (cinfo^.ac_huff_tbl_ptrs[i] <> NIL) then
 691   emit_dht(cinfo, i, TRUE);
 692     end;
 693   end;
 694
 695   emit_marker(cinfo, M_EOI);
 696 end;
 697
 698
 699 { Initialize the marker writer module. }
 700
 701 {GLOBAL}
 702 procedure jinit_marker_writer (cinfo : j_compress_ptr);
 703 var
 704   marker : my_marker_ptr;
 705 begin
 706   { Create the subobject }
 707   marker := my_marker_ptr(
 708     cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
 709         SIZEOF(my_marker_writer)) );
 710   cinfo^.marker := jpeg_marker_writer_ptr(marker);
 711   { Initialize method pointers }
 712   marker^.pub.write_file_header := write_file_header;
 713   marker^.pub.write_frame_header := write_frame_header;
 714   marker^.pub.write_scan_header := write_scan_header;
 715   marker^.pub.write_file_trailer := write_file_trailer;
 716   marker^.pub.write_tables_only := write_tables_only;
 717   marker^.pub.write_marker_header := write_marker_header;
 718   marker^.pub.write_marker_byte := write_marker_byte;
 719   { Initialize private state }
 720   marker^.last_restart_interval := 0;
 721 end;
 722
 723
 724 end.