if (cinfo^.progressive_mode) then
    begin
      { Progressive mode: only DC or only AC tables are used in one scan;
        furthermore, Huffman coding of DC refinement uses no table at all.
        We emit 0 for unused field(s); this is recommended by the P&M text
        but does not seem to be specified in the standard. }

      if (cinfo^.Ss = 0) then
      begin
	ta := 0;                { DC scan }
	if (cinfo^.Ah <> 0) and not cinfo^.arith_code then
	  td := 0;              { no DC table either }
      end
      else
      begin
	td := 0;			{ AC scan }
      end;
    end;
    emit_byte(cinfo, (td shl 4) + ta);
  end;

  emit_byte(cinfo, cinfo^.Ss);
  emit_byte(cinfo, cinfo^.Se);
  emit_byte(cinfo, (cinfo^.Ah shl 4) + cinfo^.Al);
end;


{LOCAL}
procedure emit_jfif_app0 (cinfo : j_compress_ptr);
{ Emit a JFIF-compliant APP0 marker }
{
 Length of APP0 block	(2 bytes)
 Block ID			(4 bytes - ASCII "JFIF")
 Zero byte			(1 byte to terminate the ID string)
 Version Major, Minor   (2 bytes - major first)
 Units			(1 byte - $00 = none, $01 = inch, $02 = cm)
 Xdpu			(2 bytes - dots per unit horizontal)
 Ydpu			(2 bytes - dots per unit vertical)
 Thumbnail X size		(1 byte)
 Thumbnail Y size		(1 byte)
}
begin
  emit_marker(cinfo, M_APP0);

  emit_2bytes(cinfo, 2 + 4 + 1 + 2 + 1 + 2 + 2 + 1 + 1); { length }

  emit_byte(cinfo, $4A);	{ Identifier: ASCII "JFIF" }
  emit_byte(cinfo, $46);
  emit_byte(cinfo, $49);
  emit_byte(cinfo, $46);
  emit_byte(cinfo, 0);
  emit_byte(cinfo, cinfo^.JFIF_major_version); { Version fields }
  emit_byte(cinfo, cinfo^.JFIF_minor_version);
  emit_byte(cinfo, cinfo^.density_unit); { Pixel size information }
  emit_2bytes(cinfo, int(cinfo^.X_density));
  emit_2bytes(cinfo, int(cinfo^.Y_density));
  emit_byte(cinfo, 0);		{ No thumbnail image }
  emit_byte(cinfo, 0);
end;


{LOCAL}
procedure emit_adobe_app14 (cinfo : j_compress_ptr);
{ Emit an Adobe APP14 marker }
{
  Length of APP14 block	(2 bytes)
  Block ID			(5 bytes - ASCII "Adobe")
  Version Number		(2 bytes - currently 100)
  Flags0			(2 bytes - currently 0)
  Flags1			(2 bytes - currently 0)
  Color transform		(1 byte)

  Although Adobe TN 5116 mentions Version = 101, all the Adobe files
  now in circulation seem to use Version = 100, so that's what we write.

  We write the color transform byte as 1 if the JPEG color space is
  YCbCr, 2 if it's YCCK, 0 otherwise.  Adobe's definition has to do with
  whether the encoder performed a transformation, which is pretty useless.
}
begin
  emit_marker(cinfo, M_APP14);

  emit_2bytes(cinfo, 2 + 5 + 2 + 2 + 2 + 1); { length }

  emit_byte(cinfo, $41);	{ Identifier: ASCII "Adobe" }
  emit_byte(cinfo, $64);
  emit_byte(cinfo, $6F);
  emit_byte(cinfo, $62);
  emit_byte(cinfo, $65);
  emit_2bytes(cinfo, 100);	{ Version }
  emit_2bytes(cinfo, 0);	{ Flags0 }
  emit_2bytes(cinfo, 0);	{ Flags1 }
  case (cinfo^.jpeg_color_space) of
  JCS_YCbCr:
    emit_byte(cinfo, 1);	{ Color transform = 1 }
  JCS_YCCK:
    emit_byte(cinfo, 2);	{ Color transform = 2 }
  else
    emit_byte(cinfo, 0);	{ Color transform = 0 }
  end;
end;


{ These routines allow writing an arbitrary marker with parameters.
  The only intended use is to emit COM or APPn markers after calling
  write_file_header and before calling write_frame_header.
  Other uses are not guaranteed to produce desirable results.
  Counting the parameter bytes properly is the caller's responsibility. }

{METHODDEF}
procedure write_marker_header (cinfo : j_compress_ptr;
                               marker : int;
                               datalen : uint); far;
{ Emit an arbitrary marker header }
begin
  if (datalen > uint(65533)) then  { safety check }
    ERREXIT(j_common_ptr(cinfo), JERR_BAD_LENGTH);

  emit_marker(cinfo, JPEG_MARKER(marker));

  emit_2bytes(cinfo, int(datalen + 2));	{ total length }
end;

{METHODDEF}
procedure write_marker_byte (cinfo : j_compress_ptr; val : int); far;
{ Emit one byte of marker parameters following write_marker_header }
begin
  emit_byte(cinfo, val);
end;

{ Write datastream header.
  This consists of an SOI and optional APPn markers.
  We recommend use of the JFIF marker, but not the Adobe marker,
  when using YCbCr or grayscale data.  The JFIF marker should NOT
  be used for any other JPEG colorspace.  The Adobe marker is helpful
  to distinguish RGB, CMYK, and YCCK colorspaces.
  Note that an application can write additional header markers after
  jpeg_start_compress returns. }


{METHODDEF}
procedure write_file_header (cinfo : j_compress_ptr); far;
var
  marker : my_marker_ptr;
begin
  marker := my_marker_ptr(cinfo^.marker);

  emit_marker(cinfo, M_SOI);	 { first the SOI }

  { SOI is defined to reset restart interval to 0 }
  marker^.last_restart_interval := 0;

  if (cinfo^.write_JFIF_header)	then { next an optional JFIF APP0 }
    emit_jfif_app0(cinfo);
  if (cinfo^.write_Adobe_marker) then { next an optional Adobe APP14 }
    emit_adobe_app14(cinfo);
end;


{ Write frame header.
  This consists of DQT and SOFn markers.
  Note that we do not emit the SOF until we have emitted the DQT(s).
  This avoids compatibility problems with incorrect implementations that
  try to error-check the quant table numbers as soon as they see the SOF. }


{METHODDEF}
procedure write_frame_header (cinfo : j_compress_ptr); far;
var
  ci, prec : int;
  is_baseline : boolean;
  compptr : jpeg_component_info_ptr;
begin
  { Emit DQT for each quantization table.
    Note that emit_dqt() suppresses any duplicate tables. }

  prec := 0;
  compptr := jpeg_component_info_ptr(cinfo^.comp_info);
  for ci := 0 to Pred(cinfo^.num_components) do
  begin
    prec := prec + emit_dqt(cinfo, compptr^.quant_tbl_no);
    Inc(compptr);
  end;
  { now prec is nonzero iff there are any 16-bit quant tables. }

  { Check for a non-baseline specification.
    Note we assume that Huffman table numbers won't be changed later. }

  if (cinfo^.arith_code) or (cinfo^.progressive_mode)
   or (cinfo^.data_precision <> 8) then
  begin
    is_baseline := FALSE;
  end
  else
  begin
    is_baseline := TRUE;
    compptr := jpeg_component_info_ptr(cinfo^.comp_info);
    for ci := 0 to Pred(cinfo^.num_components) do
    begin
      if (compptr^.dc_tbl_no > 1) or (compptr^.ac_tbl_no > 1) then
	is_baseline := FALSE;
      Inc(compptr);
    end;
    if (prec <> 0) and (is_baseline) then
    begin
      is_baseline := FALSE;
      { If it's baseline except for quantizer size, warn the user }
      {$IFDEF DEBUG}
      TRACEMS(j_common_ptr(cinfo), 0, JTRC_16BIT_TABLES);
      {$ENDIF}
    end;
  end;

  { Emit the proper SOF marker }
  if (cinfo^.arith_code) then
  begin
    emit_sof(cinfo, M_SOF9);	{ SOF code for arithmetic coding }
  end
  else
  begin
    if (cinfo^.progressive_mode) then
      emit_sof(cinfo, M_SOF2)	{ SOF code for progressive Huffman }
    else if (is_baseline) then
      emit_sof(cinfo, M_SOF0)	{ SOF code for baseline implementation }
    else
      emit_sof(cinfo, M_SOF1);	{ SOF code for non-baseline Huffman file }
  end;
end;


{ Write scan header.
  This consists of DHT or DAC markers, optional DRI, and SOS.
  Compressed data will be written following the SOS. }

{METHODDEF}
procedure write_scan_header (cinfo : j_compress_ptr); far;
var
  marker : my_marker_ptr;
  i : int;
  compptr : jpeg_component_info_ptr;
begin
  marker := my_marker_ptr(cinfo^.marker);
  if (cinfo^.arith_code) then
  begin
    { Emit arith conditioning info.  We may have some duplication
      if the file has multiple scans, but it's so small it's hardly
      worth worrying about. }
    emit_dac(cinfo);
  end
  else
  begin
    { Emit Huffman tables.
      Note that emit_dht() suppresses any duplicate tables. }
    for i := 0 to Pred(cinfo^.comps_in_scan) do
    begin
      compptr := cinfo^.cur_comp_info[i];
      if (cinfo^.progressive_mode) then
      begin
	{ Progressive mode: only DC or only AC tables are used in one scan }
	if (cinfo^.Ss = 0) then
        begin
	  if (cinfo^.Ah = 0) then  { DC needs no table for refinement scan }
	    emit_dht(cinfo, compptr^.dc_tbl_no, FALSE);
	end
        else
        begin
	  emit_dht(cinfo, compptr^.ac_tbl_no, TRUE);
	end;
      end
      else
      begin
	{ Sequential mode: need both DC and AC tables }
	emit_dht(cinfo, compptr^.dc_tbl_no, FALSE);
	emit_dht(cinfo, compptr^.ac_tbl_no, TRUE);
      end;
    end;
  end;

  { Emit DRI if required --- note that DRI value could change for each scan.
    We avoid wasting space with unnecessary DRIs, however. }

  if (cinfo^.restart_interval <> marker^.last_restart_interval) then
  begin
    emit_dri(cinfo);
    marker^.last_restart_interval := cinfo^.restart_interval;
  end;

  emit_sos(cinfo);
end;



{ Write datastream trailer. }


{METHODDEF}
procedure write_file_trailer (cinfo : j_compress_ptr); far;
begin
  emit_marker(cinfo, M_EOI);
end;


{ Write an abbreviated table-specification datastream.
  This consists of SOI, DQT and DHT tables, and EOI.
  Any table that is defined and not marked sent_table = TRUE will be
  emitted.  Note that all tables will be marked sent_table = TRUE at exit. }


{METHODDEF}
procedure write_tables_only (cinfo : j_compress_ptr); far;
var
  i : int;
begin
  emit_marker(cinfo, M_SOI);

  for i := 0 to Pred(NUM_QUANT_TBLS) do
  begin
    if (cinfo^.quant_tbl_ptrs[i] <> NIL) then
      emit_dqt(cinfo, i);  { dummy := ... }
  end;

  if (not cinfo^.arith_code) then
  begin
    for i := 0 to Pred(NUM_HUFF_TBLS) do
    begin
      if (cinfo^.dc_huff_tbl_ptrs[i] <> NIL) then
	emit_dht(cinfo, i, FALSE);
      if (cinfo^.ac_huff_tbl_ptrs[i] <> NIL) then
	emit_dht(cinfo, i, TRUE);
    end;
  end;

  emit_marker(cinfo, M_EOI);
end;


{ Initialize the marker writer module. }

{GLOBAL}
procedure jinit_marker_writer (cinfo : j_compress_ptr);
var
  marker : my_marker_ptr;
begin
  { Create the subobject }
  marker := my_marker_ptr(
    cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
				SIZEOF(my_marker_writer)) );
  cinfo^.marker := jpeg_marker_writer_ptr(marker);
  { Initialize method pointers }
  marker^.pub.write_file_header := write_file_header;
  marker^.pub.write_frame_header := write_frame_header;
  marker^.pub.write_scan_header := write_scan_header;
  marker^.pub.write_file_trailer := write_file_trailer;
  marker^.pub.write_tables_only := write_tables_only;
  marker^.pub.write_marker_header := write_marker_header;
  marker^.pub.write_marker_byte := write_marker_byte;
  { Initialize private state }
  marker^.last_restart_interval := 0;
end;


end.