/packages/pasjpeg/examples/jpegtran.pas

  1Program JpegTran;
  2
  3{ This file contains a command-line user interface for JPEG transcoding.
  4  It is very similar to cjpeg.c, but provides lossless transcoding between
  5  different JPEG file formats. }
  6
  7{ Original: jpegtran.c ; Copyright (C) 1995-1996, Thomas G. Lane. }
  8
  9{$define TWO_FILE_COMMANDLINE}
 10
 11{$I jconfig.inc}
 12
 13uses
 14  jdeferr,
 15  jerror,
 16  jmorecfg,
 17  jpeglib,
 18  cdjpeg,       { Common decls for cjpeg/djpeg applications }
 19  jdatasrc, JDatadst, transupp, JCTrans, JDtrans,
 20  JdAPImin, JcAPImin, JcParam,
 21  RdSwitch;
 22
 23
 24{ Argument-parsing code.
 25  The switch parser is designed to be useful with DOS-style command line
 26  syntax, ie, intermixed switches and file names, where only the switches
 27  to the left of a given file name affect processing of that file.
 28  The main program in this file doesn't actually use this capability... }
 29
 30
 31var
 32  progname,             { program name for error messages }
 33  outfilename : string; { for -outfile switch }
 34  copyoption : JCOPY_OPTION;                  { -copy switch }
 35  transformoption : jpeg_transform_info; { image transformation options }
 36
 37procedure Stop(errcode : int);
 38begin
 39  Halt(errcode);
 40end;
 41
 42{LOCAL}
 43procedure usage;
 44{ complain about bad command line }
 45begin
 46  Write(output, 'usage: ',progname,' [switches] ');
 47{$ifdef TWO_FILE_COMMANDLINE}
 48  WriteLn(output, 'inputfile outputfile');
 49{$else}
 50  WriteLn(output, '[inputfile]');
 51{$endif}
 52
 53  WriteLn(output, 'Switches (names may be abbreviated):');
 54  WriteLn('  -copy none     Copy no extra markers from source file');
 55  WriteLn('  -copy comments Copy only comment markers (default)');
 56  WriteLn('  -copy all      Copy all extra markers');
 57{$ifdef ENTROPY_OPT_SUPPORTED}
 58  WriteLn('  -optimize      Optimize Huffman table (smaller file, but slow compression)');
 59{$endif}
 60{$ifdef C_PROGRESSIVE_SUPPORTED}
 61  WriteLn('  -progressive   Create progressive JPEG file');
 62{$endif}
 63{$ifdef TRANSFORMS_SUPPORTED}
 64  WriteLn('Switches for modifying the image:');
 65  WriteLn('  -grayscale     Reduce to grayscale (omit color data)');
 66  WriteLn('  -flip [horizontal|vertical]  Mirror image (left-right or top-bottom)');
 67  WriteLn('  -rotate [90|180|270]         Rotate image (degrees clockwise)');
 68  WriteLn('  -transpose     Transpose image');
 69  WriteLn('  -transverse    Transverse transpose image');
 70  WriteLn('  -trim          Drop non-transformable edge blocks');
 71  {$ifdef CROP_SUPPORTED}
 72  WriteLn('  -cut WxH+X+Y   Cut out a subset of the image');
 73  {$endif}
 74{$endif} { TRANSFORMS_SUPPORTED }
 75  WriteLn('Switches for advanced users:');
 76  WriteLn('  -restart N     Set restart interval in rows, or in blocks with B');
 77  WriteLn('  -maxmemory N   Maximum memory to use (in kbytes)');
 78  WriteLn('  -outfile name  Specify name for output file');
 79  WriteLn('  -verbose  or  -debug   Emit debug output');
 80  WriteLn('Switches for wizards:');
 81{$ifdef C_ARITH_CODING_SUPPORTED}
 82  WriteLn('  -arithmetic    Use arithmetic coding');
 83{$endif}
 84{$ifdef C_MULTISCAN_FILES_SUPPORTED}
 85  WriteLn('  -scans file    Create multi-scan JPEG per script file');
 86{$endif}
 87  Stop(EXIT_FAILURE);
 88end;
 89
 90{LOCAL}
 91procedure select_transform (transform : JXFORM_CODE);
 92{ Silly little routine to detect multiple transform options,
 93  which we can't handle. }
 94
 95begin
 96{$ifdef TRANSFORMS_SUPPORTED}
 97  if (transformoption.transform = JXFORM_NONE) or
 98     (transformoption.transform = transform) then
 99    transformoption.transform := transform
100  else
101  begin
102    WriteLn(progname, ': can only do one image transformation at a time');
103    usage;
104  end;
105{$else}
106  WriteLn(progname, ': sorry, image transformation was not compiled');
107  exit(EXIT_FAILURE);
108{$endif}
109end;
110
111{LOCAL}
112function parse_switches (cinfo : j_compress_ptr;
113                         last_file_arg_seen: int;
114                         for_real : boolean ) : int;
115const
116  printed_version : boolean = FALSE;
117
118{ Parse optional switches.
119  Returns argv[] index of first file-name argument (= argc if none).
120  Any file names with indexes <= last_file_arg_seen are ignored;
121  they have presumably been processed in a previous iteration.
122  (Pass 0 for last_file_arg_seen on the first or only iteration.)
123  for_real is FALSE on the first (dummy) pass; we may skip any expensive
124  processing. }
125var
126  argn,
127  argc : int;
128  arg : string;
129
130  simple_progressive : boolean;
131const
132  scansarg : string = '';       { saves -scans parm if any }
133var
134  lval : long;
135  ch : char;
136  code : integer;
137begin
138  { Set up default JPEG parameters. }
139  simple_progressive := FALSE;
140  outfilename := '';
141  cinfo^.err^.trace_level := 0;
142  copyoption := JCOPYOPT_DEFAULT;
143  transformoption.transform := JXFORM_NONE;
144  transformoption.trim := FALSE;
145  transformoption.force_grayscale := FALSE;
146  cinfo^.err^.trace_level := 0;
147
148  { Scan command line options, adjust parameters }
149
150  argn := 0;
151  argc := ParamCount;
152
153  while argn < argc do
154  begin
155    Inc(argn);
156    arg := ParamStr(argn);
157    if (arg[1] <> '-') then
158    begin
159      { Not a switch, must be a file name argument }
160      if (argn <= last_file_arg_seen) then
161      begin
162        outfilename := '';      { -outfile applies to just one input file }
163        continue;               { ignore this name if previously processed }
164      end;
165      break;                    { else done parsing switches }
166    end;
167    {Inc(arg);                  - advance past switch marker character }
168
169    if (keymatch(arg, '-arithmetic', 1)) then
170    begin
171      { Use arithmetic coding. }
172{$ifdef C_ARITH_CODING_SUPPORTED}
173      cinfo^.arith_code := TRUE;
174{$else}
175      WriteLn(output, progname, ': sorry, arithmetic coding not supported');
176      Stop(EXIT_FAILURE);
177{$endif}
178    end
179    else
180      if keymatch(arg, '-copy', 2) then
181      begin { Select which extra markers to copy. }
182        Inc(argn);
183        if (argn >= argc) then          { advance to next argument }
184          usage;
185        if (keymatch(ParamStr(argn), 'none', 1)) then
186          copyoption := JCOPYOPT_NONE
187        else
188          if (keymatch(ParamStr(argn), 'comments', 1)) then
189            copyoption := JCOPYOPT_COMMENTS
190          else
191            if (keymatch(ParamStr(argn), 'all', 1)) then
192              copyoption := JCOPYOPT_ALL
193            else
194              usage;
195      end
196      else
197        if keymatch(arg, '-debug', 2) or keymatch(arg, '-verbose', 2) then
198        begin
199        { Enable debug printouts. }
200        { On first -d, print version identification }
201
202        if (not printed_version) then
203        begin
204          WriteLn('PASJPEG Group''s JPEGTRAN translation version ',
205                  JVERSION, JCOPYRIGHT, JNOTICE);
206          printed_version := TRUE;
207        end;
208        Inc(cinfo^.err^.trace_level);
209      end
210      else
211  {$ifdef CROP_SUPPORTED}
212        if keymatch(arg, '-cut', 2) then
213        begin
214        { Cut out a region of the image specified by an X geometry-like string }
215        p : PChar;
216
217          Inc(argn);
218          if (argn >= argc) then
219            usage;
220          select_transform(JXFORM_CUT);
221
222          arg := ParamStr(argn);
223                  px := Pos('x', arg);
224                  if ( px = 'x') then
225                    usage;
226                  arg_w := Copy(arg, 1, px-1);
227                  Val(arg_w, lval, code);
228                  if (code <> 0) then
229                    usage;
230
231          transformoption.newwidth := lval;
232                  arg_w := Copy(arg, px+1, Length(arg));
233                  Val(arg_w, lval, code);
234                  if (code <> 0) then
235                    usage;
236
237          transformoption.newheight := lval;
238          if (p^ <> '+') and (p^ <> '-') then
239            usage;
240                  arg_w := Copy(arg, px+1, Length(arg));
241                  Val(arg_w, lval, code);
242                  if (code <> 0) then
243                    usage;
244
245          transformoption.xoffs := lval;
246                  arg_w := Copy(arg, px+1, Length(arg));
247                  Val(arg_w, lval, code);
248                  if (code <> 0) then
249                    usage;
250
251          if (p^ <> '+') and (p^ <> '-') then
252            usage;
253          transformoption.yoffs := lval;
254
255          if (transformoption.newwidth=0) or (transformoption.newheight=0) then
256          begin
257            WriteLn(progname,': degenerate -cut size in ', argv[argn]);
258            exit(EXIT_FAILURE);
259          end
260        end
261        else
262  {$endif}
263          if keymatch(arg, '-flip', 2) then
264          begin { Mirror left-right or top-bottom. }
265            Inc(argn);
266            if (argn >= argc) then        { advance to next argument }
267              usage;
268            if keymatch(ParamStr(argn), 'horizontal', 2) then
269              select_transform(JXFORM_FLIP_H)
270            else
271              if keymatch(ParamStr(argn), 'vertical', 2) then
272                select_transform(JXFORM_FLIP_V)
273              else
274                usage;
275          end
276          else
277            if keymatch(arg, '-grayscale', 2) or
278               keymatch(arg, '-greyscale',2) then
279            begin  { Force to grayscale. }
280  {$ifdef TRANSFORMS_SUPPORTED}
281              transformoption.force_grayscale := TRUE;
282  {$else}
283              select_transform(JXFORM_NONE);    { force an error }
284  {$endif}
285            end
286            else
287              if keymatch(arg, '-maxmemory', 4) then
288              begin
289              { Maximum memory in Kb (or Mb with 'm'). }
290                ch := 'x';
291
292                Inc(argn);
293                if (argn >= argc) then  { advance to next argument }
294                  usage;
295
296                arg := ParamStr(argn);
297                if (length(arg) > 1) and (arg[length(arg)] in ['m','M']) then
298                begin
299                  ch := arg[length(arg)];
300                  arg := Copy(arg, 1, Length(arg)-1);
301                end;
302                Val(arg, lval, code);
303                if (code <> 0) then
304                  usage;
305                if (ch = 'm') or (ch = 'M') then
306                  lval := lval * long(1000);
307                cinfo^.mem^.max_memory_to_use := lval * long(1000);
308              end
309              else
310                if keymatch(arg, '-optimize', 2) or
311                   keymatch(arg, '-optimise', 2) then
312                begin
313                  { Enable entropy parm optimization. }
314      {$ifdef ENTROPY_OPT_SUPPORTED}
315                  cinfo^.optimize_coding := TRUE;
316      {$else}
317                  WriteLn(output, progname,
318                    ': sorry, entropy optimization was not compiled');
319                  Stop(EXIT_FAILURE);
320      {$endif}
321
322                end
323                else
324                  if keymatch(arg, '-outfile', 5) then
325                  begin
326                    { Set output file name. }
327                    Inc(argn);
328                    if (argn >= argc) then      { advance to next argument }
329                      usage;
330                    outfilename := ParamStr(argn);      { save it away for later use }
331                  end
332                  else
333                    if keymatch(arg, '-progressive', 2) then
334                    begin
335                      { Select simple progressive mode. }
336  {$ifdef C_PROGRESSIVE_SUPPORTED}
337                      simple_progressive := TRUE;
338                      { We must postpone execution until num_components is known. }
339  {$else}
340                      WriteLn(output, progname,
341                        ': sorry, progressive output was not compiled');
342                      Stop(EXIT_FAILURE);
343  {$endif}
344                    end
345                    else
346                      if keymatch(arg, '-restart', 2) then
347                      begin
348                        ch := 'x';
349                        { Restart interval in MCU rows (or in MCUs with 'b'). }
350                        Inc(argn);
351                        if (argn >= argc) then { advance to next argument }
352                          usage;
353                        arg := ParamStr(argn);
354                        if (length(arg) > 1) and (arg[length(arg)] in ['b','B']) then
355                        begin
356                          ch := arg[length(arg)];
357                          arg := Copy(arg, 1, Length(arg)-1);
358                        end;
359
360                        Val(arg, lval, code);
361                        if (code <> 1) or (lval < 0) or (lval > Long(65535)) then
362                          usage;
363
364                        if (ch = 'b') or (ch = 'B') then
365                        begin
366                          cinfo^.restart_interval := uint(lval);
367                          cinfo^.restart_in_rows := 0; { else prior '-restart n' overrides me }
368                        end
369                        else
370                        begin
371                          cinfo^.restart_in_rows := int(lval);
372                          { restart_interval will be computed during startup }
373                        end;
374
375                      end
376                      else
377                        if keymatch(arg, '-rotate', 3) then
378                        begin { Rotate 90, 180, or 270 degrees (measured clockwise). }
379                          Inc(argn);
380                          if (argn >= argc)     then { advance to next argument }
381                            usage;
382                          if (keymatch(ParamStr(argn), '90', 2)) then
383                            select_transform(JXFORM_ROT_90)
384                          else
385                            if keymatch(ParamStr(argn), '180', 3) then
386                              select_transform(JXFORM_ROT_180)
387                            else
388                              if keymatch(ParamStr(argn), '270', 3) then
389                                select_transform(JXFORM_ROT_270)
390                              else
391                                usage;
392                         end
393                         else
394                         if keymatch(arg, '-scans', 2) then
395                         begin
396                           { Set scan script. }
397         {$ifdef C_MULTISCAN_FILES_SUPPORTED}
398                           Inc(argn);
399                           if (argn >= argc) then       { advance to next argument }
400                             usage;
401                           scansarg := ParamStr(argn);
402                           { We must postpone reading the file in case -progressive appears. }
403         {$else}
404                           WriteLn(output, progname,
405                             ': sorry, multi-scan output was not compiled');
406                           Stop(EXIT_FAILURE);
407         {$endif}
408                         end
409                         else
410                           if keymatch(arg, '-transpose', 2) then
411                             { Transpose (across UL-to-LR axis). }
412                             select_transform(JXFORM_TRANSPOSE)
413                           else
414                             if keymatch(arg, '-transverse', 7) then
415                               { Transverse transpose (across UR-to-LL axis). }
416                               select_transform(JXFORM_TRANSVERSE)
417                             else
418                               if keymatch(arg, '-trim', 4) then
419                                 { Trim off any partial edge MCUs that
420                                   the transform can't handle. }
421                                 transformoption.trim := TRUE
422                               else
423                                 usage;                { bogus switch }
424  end;
425
426  { Post-switch-scanning cleanup }
427
428  if (for_real) then
429  begin
430
431{$ifdef C_PROGRESSIVE_SUPPORTED}
432    if (simple_progressive) then { process -progressive; -scans can override }
433      jpeg_simple_progression(cinfo);
434{$endif}
435
436{$ifdef C_MULTISCAN_FILES_SUPPORTED}
437    if (scansarg <> '') then       { process -scans if it was present }
438    begin
439      WriteLn('Scripts are not supported in PasJPEG.');
440      {if not read_scan_script(cinfo, scansarg) then
441        usage;
442      }
443    end;
444{$endif}
445  end;
446
447  parse_switches  := argn;      { return index of next arg (file name) }
448end;
449
450
451{ The main program. }
452
453{main (int argc, char **argv)}
454var
455  srcinfo : jpeg_decompress_struct;
456  dstinfo : jpeg_compress_struct;
457  jsrcerr, jdsterr : jpeg_error_mgr;
458{$ifdef PROGRESS_REPORT}
459  progress : cdjpeg_progress_mgr;
460{$endif}
461  src_coef_arrays,
462  dst_coef_arrays : jvirt_barray_tbl_ptr;
463  file_index : int;
464  input_file : FILE;
465  output_file : FILE;
466begin
467  { On Mac, fetch a command line. }
468{$ifdef USE_CCOMMAND}
469  argc := ccommand(@argv);
470{$endif}
471
472  progname := ParamStr(0);
473
474  { Initialize the JPEG decompression object with default error handling. }
475  srcinfo.err := jpeg_std_error(jsrcerr);
476  jpeg_create_decompress(@srcinfo);
477  { Initialize the JPEG compression object with default error handling. }
478  dstinfo.err := jpeg_std_error(jdsterr);
479  jpeg_create_compress(@dstinfo);
480
481  { Now safe to enable signal catcher.
482    Note: we assume only the decompression object will have virtual arrays. }
483
484{$ifdef NEED_SIGNAL_CATCHER}
485  enable_signal_catcher(j_common_ptr(@srcinfo));
486{$endif}
487
488  { Scan command line to find file names.
489    It is convenient to use just one switch-parsing routine, but the switch
490    values read here are mostly ignored; we will rescan the switches after
491    opening the input file.  Also note that most of the switches affect the
492    destination JPEG object, so we parse into that and then copy over what
493    needs to affects the source too. }
494
495  file_index := parse_switches(@dstinfo, 0, FALSE);
496  jsrcerr.trace_level := jdsterr.trace_level;
497  srcinfo.mem^.max_memory_to_use := dstinfo.mem^.max_memory_to_use;
498
499{$ifdef TWO_FILE_COMMANDLINE}
500  { Must have either -outfile switch or explicit output file name }
501  if (outfilename = '') then
502  begin
503    if (file_index <> ParamCount-1) then
504    begin
505      WriteLn(output, progname, ': must name one input and one output file');
506      usage;
507    end;
508    outfilename := ParamStr(file_index+1);
509  end
510  else
511  begin
512    if (file_index <> ParamCount-1) then
513    begin
514      WriteLn(output, progname, ': must name one input and one output file');
515      usage;
516    end;
517  end;
518{$else}
519  { Unix style: expect zero or one file name }
520  if (file_index < argc-1) then
521  begin
522    WriteLn(output, progname, ': only one input file');
523    usage;
524  end;
525{$endif} { TWO_FILE_COMMANDLINE }
526
527  { Open the input file. }
528  if (file_index < ParamCount) then
529  begin
530    assign(input_file, ParamStr(file_index));
531{$push}{$I-}
532    reset(input_file, 1);
533{$pop}
534    if (IOresult <> 0) then
535    begin
536      WriteLn(output, progname, ': can''t open ', ParamStr(file_index));
537      Stop(EXIT_FAILURE);
538    end;
539  end
540  else
541  begin
542    { default input file is stdin }
543    assign(input_file, '');
544    reset(input_file, 1);
545  end;
546
547  { Open the output file. }
548  if (outfilename <> '') then
549  begin
550    assign(output_file, outfilename);
551{$push}{$I-}
552    rewrite(output_file, 1);
553{$pop}
554    if (IOresult <> 0) then
555    begin
556      WriteLn(output, progname, ': can''t open ', outfilename);
557      Stop(EXIT_FAILURE);
558    end;
559  end
560  else
561  begin
562    { default output file is stdout }
563    assign(output_file, '');
564    rewrite(output_file, 1);
565  end;
566
567{$ifdef PROGRESS_REPORT}
568  start_progress_monitor(j_common_ptr(@dstinfo), @progress);
569{$endif}
570
571  { Specify data source for decompression }
572  jpeg_stdio_src(@srcinfo, @input_file);
573
574  { Enable saving of extra markers that we want to copy }
575  jcopy_markers_setup(@srcinfo, copyoption);
576
577  { Read file header }
578  {void} jpeg_read_header(@srcinfo, TRUE);
579
580  { Any space needed by a transform option must be requested before
581    jpeg_read_coefficients so that memory allocation will be done right. }
582
583{$ifdef TRANSFORMS_SUPPORTED}
584  jtransform_request_workspace(@srcinfo, transformoption);
585{$endif}
586
587  { Read source file as DCT coefficients }
588  src_coef_arrays := jpeg_read_coefficients(@srcinfo);
589
590  { Initialize destination compression parameters from source values }
591  jpeg_copy_critical_parameters(@srcinfo, @dstinfo);
592
593  { Adjust destination parameters if required by transform options;
594    also find out which set of coefficient arrays will hold the output. }
595
596{$ifdef TRANSFORMS_SUPPORTED}
597  dst_coef_arrays := jtransform_adjust_parameters(@srcinfo, @dstinfo,
598                                                 src_coef_arrays,
599                                                 transformoption);
600{$else}
601  dst_coef_arrays := src_coef_arrays;
602{$endif}
603
604  { Adjust default compression parameters by re-parsing the options }
605  file_index := parse_switches(@dstinfo, 0, TRUE);
606
607  { Specify data destination for compression }
608  jpeg_stdio_dest(@dstinfo, @output_file);
609
610  { Start compressor (note no image data is actually written here) }
611  jpeg_write_coefficients(@dstinfo, dst_coef_arrays);
612
613  { Copy to the output file any extra markers that we want to preserve }
614  jcopy_markers_execute(@srcinfo, @dstinfo, copyoption);
615
616  { Execute image transformation, if any }
617{$ifdef TRANSFORMS_SUPPORTED}
618  jtransform_execute_transformation(@srcinfo, @dstinfo,
619                                    src_coef_arrays,
620                                    transformoption);
621{$endif}
622
623  { Finish compression and release memory }
624  jpeg_finish_compress(@dstinfo);
625  jpeg_destroy_compress(@dstinfo);
626  {void} jpeg_finish_decompress(@srcinfo);
627  jpeg_destroy_decompress(@srcinfo);
628
629  { Close files, if we opened them }
630  close(input_file);
631  close(output_file);
632
633{$ifdef PROGRESS_REPORT}
634  end_progress_monitor(j_common_ptr(@dstinfo));
635{$endif}
636
637  { All done. }
638  if jsrcerr.num_warnings + jdsterr.num_warnings <> 0 then
639    Stop(EXIT_WARNING)
640  else
641    Stop(EXIT_SUCCESS);
642end.