/packages/pasjpeg/examples/jpegtran.pas
Pascal | 642 lines | 423 code | 71 blank | 148 comment | 63 complexity | f5950a46b7a42db24c871501db09a790 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
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.