cjpeg.pas

用pascal寫的jpeg codec, 測試過的

Program cjpeg;

{ Original: cjpeg.c ; Copyright (C) 1991-1996, Thomas G. Lane. }

{ This file contains a command-line user interface for the JPEG compressor. }

{ Two different command line styles are permitted, depending on the
  compile-time switch TWO_FILE_COMMANDLINE:
 	cjpeg [options]  inputfile outputfile
 	cjpeg [options]  [inputfile]
  In the second style, output is always to standard output, which you'd
  normally redirect to a file or pipe to some other program.  Input is
  either from a named file or from standard input (typically redirected).
  The second style is convenient on Unix but is unhelpful on systems that
  don't support pipes.  Also, you MUST use the first style if your system
  doesn't do binary I/O to stdin/stdout.
  To simplify script writing, the "-outfile" switch is provided.  The syntax
 	cjpeg [options]  -outfile outputfile  inputfile
  works regardless of which command line style is used. }

{$I jconfig.inc}

{$define TWO_FILE_COMMANDLINE}
{$define BMP_SUPPORTED}
{-$define GIF_SUPPORTED}
{-$define PPM_SUPPORTED}
{-$define RLE_SUPPORTED}
{$define TARGA_SUPPORTED}



uses
  jmorecfg,
  cdjpeg,		{ Common decls for cjpeg/djpeg applications }
  {jversion,		{ for version message }
  jpeglib,

  jerror,
  jinclude, JDataDst,
  JcAPImin, JcAPIstd, JcParam,
{$ifdef TARGA_SUPPORTED}
  rdtarga,
{$endif}
{$ifdef BMP_SUPPORTED}
  rdbmp,
{$endif}
{$ifdef EXT_SWITCH}
  rdswitch,
{$endif}
  {cderror,}
  jdeferr;


{ This routine determines what format the input file is,
  and selects the appropriate input-reading module.

  To determine which family of input formats the file belongs to,
  we may look only at the first byte of the file, since C does not
  guarantee that more than one character can be pushed back with ungetc.
  Looking at additional bytes would require one of these approaches:
      1) assume we can fseek() the input file (fails for piped input);
      2) assume we can push back more than one character (works in
         some C implementations, but unportable);
      3) provide our own buffering (breaks input readers that want to use
         stdio directly, such as the RLE library);
  or  4) don't put back the data, and modify the input_init methods to assume
         they start reading after the start of file (also breaks RLE library).
  #1 is attractive for MS-DOS but is untenable on Unix.

  The most portable solution for file types that can't be identified by their
  first byte is to make the user tell us what they are.  This is also the
  only approach for "raw" file types that contain only arbitrary values.
  We presently apply this method for Targa files.  Most of the time Targa
  files start with $00, so we recognize that case.  Potentially, however,
  a Targa file could start with any byte value (byte 0 is the length of the
  seldom-used ID field), so we provide a switch to force Targa input mode. }


var
 is_targa : boolean;	{ records user -targa switch }

function GetFirstChar(cinfo : j_compress_ptr;
                      fptr : fileptr) : char;
var
  c : char;
begin
  if JFREAD(fptr^, @c, 1) <> 1 then
    ERREXIT(j_common_ptr(cinfo), JERR_INPUT_EMPTY);

  Seek(fptr^, 0);        { Nomssi: probably not portable }
  if (IOresult <> 0) then
    ERREXIT(j_common_ptr(cinfo), JERR_UNGETC_FAILED);
  GetFirstChar := c;
end;


{LOCAL}
function select_file_type (cinfo : j_compress_ptr;
                           var infile : FILE) : cjpeg_source_ptr;
var
  c : char;
begin
  if (is_targa) then
  begin
{$ifdef TARGA_SUPPORTED}
    select_file_type := jinit_read_targa(cinfo);
    exit;
{$else}
    ERREXIT(j_common_ptr(cinfo), JERR_TGA_NOTCOMP);
{$endif}
  end;

  c := GetFirstChar(cinfo, @infile);

  select_file_type := NIL;	{ suppress compiler warnings }
  case c of
{$ifdef BMP_SUPPORTED}
  'B': select_file_type := jinit_read_bmp(cinfo);
{$endif}
{$ifdef GIF_SUPPORTED}
  'G': select_file_type := jinit_read_gif(cinfo);
{$endif}
{$ifdef PPM_SUPPORTED}
  'P': select_file_type := jinit_read_ppm(cinfo);
{$endif}
{$ifdef RLE_SUPPORTED}
  'R': select_file_type := jinit_read_rle(cinfo);
{$endif}
{$ifdef TARGA_SUPPORTED}
  char($00): select_file_type := jinit_read_targa(cinfo);
{$endif}
  else
    ERREXIT(j_common_ptr(cinfo), JERR_UNKNOWN_FORMAT);
  end;
end;


{ Argument-parsing code.
  The switch parser is designed to be useful with DOS-style command line
  syntax, ie, intermixed switches and file names, where only the switches
  to the left of a given file name affect processing of that file.
  The main program in this file doesn't actually use this capability... }


var
  progname,	{ program name for error messages }
  outfilename : string[79];	{ for -outfile switch }


{LOCAL}
procedure usage;
{ complain about bad command line }
begin
  Write(output, 'usage: ', progname, ' [switches] ');
{$ifdef TWO_FILE_COMMANDLINE}
  WriteLn(output, 'inputfile outputfile');
{$else}
  WriteLn(output, '[inputfile]');
{$endif}

  WriteLn(output, 'Switches (names may be abbreviated):');
  WriteLn(output, '  -quality N     Compression quality (0..100; 5-95 is useful range)');
  WriteLn(output, '  -grayscale     Create monochrome JPEG file');
{$ifdef ENTROPY_OPT_SUPPORTED}
  WriteLn(output, '  -optimize      Optimize Huffman table (smaller file, but slow compression)');
{$endif}
{$ifdef C_PROGRESSIVE_SUPPORTED}
  WriteLn(output, '  -progressive   Create progressive JPEG file');
{$endif}
{$ifdef TARGA_SUPPORTED}
  WriteLn(output, '  -targa         Input file is Targa format (usually not needed)');
{$endif}
  WriteLn(output, 'Switches for advanced users:');
{$ifdef DCT_ISLOW_SUPPORTED}
  if (JDCT_DEFAULT = JDCT_ISLOW) then
    WriteLn(output, '  -dct int       Use integer DCT method (default)')
  else
    WriteLn(output, '  -dct int       Use integer DCT method');
{$endif}
{$ifdef DCT_IFAST_SUPPORTED}
  if (JDCT_DEFAULT = JDCT_IFAST) then
    WriteLn(output, '  -dct fast      Use fast integer DCT (less accurate) (default)')
  else
    WriteLn(output, '  -dct fast      Use fast integer DCT (less accurate)');
{$endif}
{$ifdef DCT_FLOAT_SUPPORTED}
  if (JDCT_DEFAULT = JDCT_FLOAT) then
    WriteLn(output, '  -dct float     Use floating-point DCT method (default)')
  else
    WriteLn(output, '  -dct float     Use floating-point DCT method');
{$endif}
  WriteLn(output, '  -restart N     Set restart interval in rows, or in blocks with B');
{$ifdef INPUT_SMOOTHING_SUPPORTED}
  WriteLn(output, '  -smooth N      Smooth dithered input (N=1..100 is strength)');
{$endif}
  WriteLn(output, '  -maxmemory N   Maximum memory to use (in kbytes)');
  WriteLn(output, '  -outfile name  Specify name for output file');
  WriteLn(output, '  -verbose  or  -debug   Emit debug output');
{$IFDEF EXT_SWITCH}
  WriteLn(output, 'Switches for wizards:');
{$ifdef C_ARITH_CODING_SUPPORTED}
  WriteLn(output, '  -arithmetic    Use arithmetic coding');
{$endif}
  WriteLn(output, '  -baseline      Force baseline output');
  WriteLn(output, '  -qtables file  Use quantization tables given in file');
  WriteLn(output, '  -qslots N[,...]    Set component quantization tables');
  WriteLn(output, '  -sample HxV[,...]  Set component sampling factors');
{$ifdef C_MULTISCAN_FILES_SUPPORTED}
  WriteLn(output, '  -scans file    Create multi-scan JPEG per script file');
{$endif}
{$ENDIF}
  Halt(EXIT_FAILURE);
end;


{LOCAL}
function parse_switches (cinfo : j_compress_ptr;
		         last_file_arg_seen : int;
                         for_real : boolean) : int;
{ Parse optional switches.
  Returns argv[] index of first file-name argument (== argc if none).
  Any file names with indexes <= last_file_arg_seen are ignored;
  they have presumably been processed in a previous iteration.
  (Pass 0 for last_file_arg_seen on the first or only iteration.)
  for_real is FALSE on the first (dummy) pass; we may skip any expensive
  processing. }

var
  argn,
  argc : int;
  arg : string;
var
  value, code : int;
var
  quality : int;		{ -quality parameter }
  q_scale_factor : int;		{ scaling percentage for -qtables }
  force_baseline : boolean;
  simple_progressive : boolean;
  qtablefile,                  { saves -qtables filename if any }
  qslotsarg,                   { saves -qslots parm if any }
  samplearg,                   { saves -sample parm if any }
  scansarg : string;           { saves -scans parm if any }
var
  lval : long;
  ch : char;

const
  printed_version : boolean = FALSE;
begin
  qtablefile := '';
  qslotsarg := '';
  samplearg := '';
  scansarg := '';

  { Set up default JPEG parameters. }
  { Note that default -quality level need not, and does not,
    match the default scaling for an explicit -qtables argument. }

  quality := 75;			{ default -quality value }
  q_scale_factor := 100;		{ default to no scaling for -qtables }
  force_baseline := FALSE;	{ by default, allow 16-bit quantizers }
  simple_progressive := FALSE;
  is_targa := FALSE;
  outfilename := '';
  cinfo^.err^.trace_level := 0;

  { Scan command line options, adjust parameters }

  argn := 0;
  argc := ParamCount;

  while argn <= ParamCount do
  begin
    Inc(argn);
    arg := ParamStr(argn);
    if (arg[1] <> '-') then
    begin
      { Not a switch, must be a file name argument }
      if (argn <= last_file_arg_seen) then
      begin
	outfilename := '';	{ -outfile applies to just one input file }
	continue;		{ ignore this name if previously processed }
      end;
      break;			{ else done parsing switches }
    end;
    {Inc(arg);			{ advance past switch marker character }

    if (keymatch(arg, '-arithmetic', 2)) then
    begin
      { Use arithmetic coding. }
{$ifdef C_ARITH_CODING_SUPPORTED}
      cinfo^.arith_code := TRUE;
{$else}
      WriteLn(output, progname, ': sorry, arithmetic coding not supported');
      Halt(EXIT_FAILURE);
{$endif}

    end
    else
      if (keymatch(arg, '-baseline', 2)) then
      begin
      { Force baseline output (8-bit quantizer values). }
      force_baseline := TRUE;

    end
    else
    if (keymatch(arg, '-dct', 3)) then
    begin
      { Select DCT algorithm. }
      Inc(argn);
      if (argn >= argc) then	{ advance to next argument }
	usage;
      if (keymatch(ParamStr(argn), 'int', 1)) then
      begin
	cinfo^.dct_method := JDCT_ISLOW;
      end
      else
        if (keymatch(ParamStr(argn), 'fast', 2)) then
        begin
	  cinfo^.dct_method := JDCT_IFAST;
        end
        else
          if (keymatch(ParamStr(argn), 'float', 2)) then
          begin
	    cinfo^.dct_method := JDCT_FLOAT;
          end
          else
	    usage;

    end
    else
      if keymatch(arg, '-debug', 2) or keymatch(arg, '-verbose', 2) then
      begin
        { Enable debug printouts. }
        { On first -d, print version identification }

        if (not printed_version) then
        begin
	  WriteLn(output, 'Independent JPEG Group''s CJPEG, version ', JVERSION);
          WriteLn(output, JCOPYRIGHT);
          WriteLn(output, JNOTICE);
	  printed_version := TRUE;
        end;
        Inc(cinfo^.err^.trace_level);

      end
      else
      if (keymatch(arg, '-grayscale', 3)) or (keymatch(arg, '-greyscale',3)) then
      begin
        { Force a monochrome JPEG file to be generated. }
        jpeg_set_colorspace(cinfo, JCS_GRAYSCALE);

      end
      else
        if (keymatch(arg, '-maxmemory', 4)) then
        begin
          ch := 'x';

          Inc(argn);
          if (argn >= argc) then	{ advance to next argument }
	    usage;
          Val(ParamStr(argn), lval, code);
          if (code <> 1) then
	    usage;
          if (ch = 'm') or (ch = 'M') then
	    lval := lval * long(1000);
          cinfo^.mem^.max_memory_to_use := lval * long(1000);

        end
        else
          if (keymatch(arg, '-optimize', 2)) or (keymatch(arg, '-optimise', 2)) then
          begin
            { Enable entropy parm optimization. }
      {$ifdef ENTROPY_OPT_SUPPORTED}