/packages/pasjpeg/examples/jpegtran.pas

https://github.com/slibre/freepascal · Pascal · 642 lines · 423 code · 71 blank · 148 comment · 63 complexity · f5950a46b7a42db24c871501db09a790 MD5 · raw file

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