home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / misc / volume33 / icontact / part02 < prev    next >
Encoding:
Text File  |  1992-11-01  |  40.9 KB  |  1,403 lines
  1. Newsgroups: comp.sources.misc
  2. From: cs62a12@wind.ucsd.edu (Mark Hanson)
  3. Subject:  v33i031:  icontact - perl script to create contact sheets of images, v1.3, Part02/02
  4. Message-ID: <1992Nov2.052209.28075@sparky.imd.sterling.com>
  5. X-Md4-Signature: bba5fda55f3c883f7f383ca03f67cec7
  6. Date: Mon, 2 Nov 1992 05:22:09 GMT
  7. Approved: kent@sparky.imd.sterling.com
  8.  
  9. Submitted-by: cs62a12@wind.ucsd.edu (Mark Hanson)
  10. Posting-number: Volume 33, Issue 31
  11. Archive-name: icontact/part02
  12. Environment: UNIX, perl, pbmplus
  13. Supersedes: icontact: Volume 30, Issue 77
  14.  
  15. #! /bin/sh
  16. # This is a shell archive.  Remove anything before this line, then unpack
  17. # it by saving it into a file and typing "sh file".  To overwrite existing
  18. # files, type "sh file -c".  You can also feed this as standard input via
  19. # unshar, or by typing "sh <file", e.g..  If this archive is complete, you
  20. # will see the following message at the end:
  21. #        "End of archive 2 (of 2)."
  22. # Contents:  icontact
  23. # Wrapped by mark@eggman on Sun Oct 25 15:29:45 1992
  24. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  25. if test -f 'icontact' -a "${1}" != "-c" ; then 
  26.   echo shar: Will not clobber existing file \"'icontact'\"
  27. else
  28. echo shar: Extracting \"'icontact'\" \(38651 characters\)
  29. sed "s/^X//" >'icontact' <<'END_OF_FILE'
  30. X#!/usr/local/bin/perl
  31. X
  32. X# Copyright (C) 1992 Mark B. Hanson
  33. X# Permission to use, copy, modify, and distribute this software and its
  34. X# documentation for any purpose and without fee is hereby granted,
  35. X# provided that both the above copyright notice and this permission
  36. X# notice appear in all copies and in supporting documentation.  This
  37. X# software is provided "as is" without express or implied warranty.
  38. X
  39. X$program = 'icontact';
  40. X$version = '1.3 (25oct92)';
  41. X$copyright = 'Copyright (C) 1992';
  42. X$author = 'Mark B. Hanson (cs62a12@wind.ucsd.edu)';
  43. X
  44. X
  45. X#
  46. X# default values for parameters that correspond to command line switches
  47. X# (you probably don't want to change these. use a configuration file instead)
  48. X#
  49. X
  50. X$AutoOff = 0;       # boolean,  0 = sheet numbers start with 0
  51. X                    #           1 = start with next highest number
  52. X$Auto = 0;          # boolean,  0 = use $Columns and $Rows
  53. X                    #           1 = dynamically sized to $Xdim, $Ydim
  54. X$Base = 0;          # boolean,  0 = display whole filename in labels 
  55. X                    #           1 = display basename of filenames in labels 
  56. X$Borders = 0;       # boolean,  0 = no spiffy borders around each image
  57. X                    #           1 = spiffy borders around each image
  58. X$Ignore = 0;        # boolean,  0 = use configuration file
  59. X                    #           1 = don't use configuration file
  60. X$Ident = 0;         # boolean,  0 = don't pad images, just scale them
  61. X                    #           1 = pad each image to be the same size
  62. X$Labels = 0;        # boolean,  0 = no labels
  63. X                    #           1 = labels
  64. X$Left = 0;          # boolean,  0 = center justify rows
  65. X                    #           1 = left justify rows
  66. X$Param = 0;         # boolean,  0 = no parameter files for sheets
  67. X                    #           1 = generate parameter files for sheets
  68. X$Silent = 0;        # boolean,  0 = normal output
  69. X                    #           1 = no output except warnings and errors
  70. X$Sort = 0;          # boolean,  0 = don't sort filenames
  71. X                    #           1 = sort filenames
  72. X$Uniq = 0;          # boolean,  0 = leave duplicates in file list
  73. X                    #           1 = remove duplicates from file list
  74. X$Verbose = 0;       # boolean,  0 = normal output
  75. X                    #           1 = show execution
  76. X$Xsame = 0;         # boolean,  0 = don't make all the images the same width
  77. X                    #           1 = make all the images the same width
  78. X$Ysame = 0;         # boolean,  0 = don't make all the images the same height
  79. X                    #           1 = make all the images the same height
  80. X
  81. X$Columns = 7;       # n > 0,    number of columns in sheets (!auto mode)
  82. X$Rows = 7;          # n > 0,    number of rows in sheets (!auto mode)
  83. X
  84. X$Xdim = 1152;       # n > 0,    width of max sheet size (auto mode)
  85. X$Ydim = 900;        # n > 0,    height of max sheet size (auto mode)
  86. X
  87. X$Width = 100;       # n > 0,    max width of each image
  88. X$Height = 100;      # n > 0,    max height of each image
  89. X
  90. X$Config = '~/.icrc';# string,   name of the configuration file
  91. X
  92. X$Dir =  '.';        # string,   directory to put finished sheets in
  93. X
  94. X$Prefix = 'ic-';    # string,   prefix for filename of sheets
  95. X
  96. X$Offset = 1;        # n > 0,    start at n when numbering the sheets
  97. X
  98. X$Tempdir = '/tmp';  # string,   directory to use for temporary files
  99. X
  100. X$Font = '';         # string,   name of a file to use as a font with pbmtext
  101. X                    #           null = use default.
  102. X
  103. X$Format = '.ppm.Z'; # string,   the format in which sheets are to be encoded
  104. X
  105. X$Namefile = '';     # string,   name of a file from which to get more filenames
  106. X
  107. X$Suffix = '.icp';   # string,   suffix of parameter files
  108. X
  109. X$Quant = 0;         # n >= 0,   number of colors to be left in sheets
  110. X                    #           a value of 0 means no quantization
  111. X
  112. X$Qprog =            # string,   quantization program that takes the number of
  113. X    'ppmquant -fs'; #           colors as an argument
  114. X
  115. X$DefFmt = '.gif';   # string,   default format to use if image has no suffix.
  116. X
  117. X$Stripe =           # string,   list of colors to be used for borders
  118. X    'black white black';
  119. X
  120. X$Text = 'white';    # string,   color of text for labels
  121. X
  122. X$Back = 'black';    # string,   default color for background
  123. X
  124. X$Pad = $Back;       # string,   color to use for padding area when using -i
  125. X
  126. X$Nice = 0;          # n,        nice value for children
  127. X
  128. X
  129. X#
  130. X# The tables below are filled with common examples that I typed in to save
  131. X# you some time and to give you a feel for how icontact decides how to
  132. X# {en,de}code files.  Don't worry if your particular set of favorite programs
  133. X# and file name extensions is not listed here.  Like it says in the man
  134. X# page: `icontact is highly configurable.'  Use a configuration file to make
  135. X# icontact use any set of programs and filename extensions you want.
  136. X#
  137. X
  138. X#
  139. X# associative array to go from file suffix -> ppm.
  140. X#
  141. X
  142. X%decode = (
  143. X    'Z',        'trap \'exit 130\' 2; zcat',
  144. X    'atk',      'atktopbm',
  145. X    'brush',    'brushtopbm',
  146. X    'cmuwm',    'cmuwmtopbm',
  147. X    'fits',     'fitstopgm',
  148. X    'fs',       'fstopgm',
  149. X    'g3',       'g3topbm',
  150. X    'gem',      'gemtopbm',
  151. X    'gif',      'giftoppm',
  152. X    'gould',    'gouldtoppm',
  153. X    'hips',     'hipstopgm',
  154. X    'icon',     'icontopbm',
  155. X    'ilbm',     'ilbmtoppm',
  156. X    'jpg',      'djpeg',
  157. X    'lispm',    'lispmtopgm',
  158. X    'macp',     'macptopbm',
  159. X    'mgr',      'mgrtopbm',
  160. X    'mtv',      'mtvtoppm',
  161. X    'pbm',      '',
  162. X    'pcx',      'pcxtoppm',
  163. X    'pgm',      '',
  164. X    'pi1',      'pi1toppm',
  165. X    'pi3',      'pi3toppm',
  166. X    'pict',     'picttoppm',
  167. X    'pj',       'pjtoppm',
  168. X    'ppm',      '',
  169. X    'qrt',      'qrttoppm',
  170. X    'rast',     'rasttopnm',
  171. X    'spc',      'spctoppm',
  172. X    'spu',      'sputoppm',
  173. X    'tga',      'tgatoppm',
  174. X    'tiff',     'tifftopnm',
  175. X    'tif',      'tifftopnm',
  176. X    'xbm',      'xbmtopbm',
  177. X    'xim',      'ximtoppm',
  178. X    'xpm',      'xpmtoppm',
  179. X    'xwd',      'xwdtopnm',
  180. X    'ybm',      'ybmtopbm',
  181. X    'yuv',      'yuvtoppm',
  182. X);
  183. X
  184. X
  185. X#
  186. X# associative array to go from ppm -> file suffix.
  187. X#
  188. X
  189. X%encode = (
  190. X    '10x',      'ppmtopgm | pgmtopbm | pbmto10x',
  191. X    'Z',        '(compress -v -f; exit 0)',
  192. X    'ascii',    'ppmtopgm | pgmtopbm | pbmtoascii',
  193. X    'atk',      'ppmtopgm | pgmtopbm | pbmtoatk',
  194. X    'bbnbg',    'ppmtopgm | pgmtopbm | pbmtobbnbg',
  195. X    'cmuwm',    'ppmtopgm | pgmtopbm | pbmtocmuwm',
  196. X    'epson',    'ppmtopgm | pgmtopbm | pbmtoepson',
  197. X    'fits',     'ppmtopgm | pgmtofits',
  198. X    'fs',       'ppmtopgm | pgmtofs',
  199. X    'g3',       'ppmtopgm | pgmtopbm | pbmtog3',
  200. X    'gem',      'ppmtopgm | pgmtopbm | pbmtogem',
  201. X    'gif',      'ppmtogif',
  202. X    'go',       'ppmtopgm | pgmtopbm | pbmtogo',
  203. X    'icon',     'ppmtopgm | pgmtopbm | pbmtoicon',
  204. X    'icr',      'ppmtoicr',
  205. X    'ilbm',     'ppmtoilbm',
  206. X    'jpg',      'cjpeg -o',
  207. X    'lispm',    'ppmtopgm | pgmtolispm',
  208. X    'lj',       'ppmtopgm | pgmtopbm | pbmtolj',
  209. X    'macp',     'ppmtopgm | pgmtopbm | pbmtomacp',
  210. X    'mgr',      'ppmtopgm | pgmtopbm | pbmtomgr',
  211. X    'pbm',      'ppmtopgm | pgmtopbm',
  212. X    'pcx',      'ppmtopcx',
  213. X    'pgm',      'ppmtopgm',
  214. X    'pi1',      'ppmtopi1',
  215. X    'pi3',      'ppmtopgm | pgmtopbm | pbmtopi3',
  216. X    'pict',     'ppmtopict',
  217. X    'pj',       'ppmtopj',
  218. X    'plot',     'ppmtopgm | pgmtopbm | pbmtoplot',
  219. X    'ppm',      '',
  220. X    'ps',       'pnmtops',
  221. X    'ptx',      'ppmtopgm | pgmtopbm | pbmtoptx',
  222. X    'puzz',     'ppmtopuzz',
  223. X    'rast',     'pnmtorast',
  224. X    'sixel',    'ppmtosixel',
  225. X    'tga',      'ppmtotga',
  226. X    'tiff',     'pnmtotiff',
  227. X    'tif',      'pnmtotiff',
  228. X    'uil',      'ppmtouil',
  229. X    'x10bm',    'ppmtopgm | pgmtopbm | pbmtox10bm',
  230. X    'xbm',      'ppmtopgm | pgmtopbm | pbmtoxbm',
  231. X    'xpm',      'ppmtoxpm',
  232. X    'xwd',      'pnmtoxwd',
  233. X    'ybm',      'ppmtopgm | pgmtopbm | pbmtoybm',
  234. X    'yuv',      'ppmtoyuv',
  235. X    'zinc',     'ppmtopgm | pgmtopbm | pbmtozinc',
  236. X);
  237. X
  238. X
  239. X#
  240. X# default quantization values based upon output file suffix.
  241. X# if a format's default quant value is the default for the -q switch
  242. X# ($Quant), don't bother listing it.
  243. X#
  244. X
  245. X%defquant = (
  246. X    'gif',      256,
  247. X);
  248. X
  249. X
  250. X#
  251. X# mapping from command line switches to internal variable names
  252. X#
  253. X
  254. X%optvar = (
  255. X    'a', 'Auto',    'B', 'Borders', 'b', 'Base',    'C', 'Back',
  256. X    'c', 'Columns', 'D', 'DefFmt',  'd', 'Dir',     'F', 'Font',
  257. X    'f', 'Format',  'g', 'Param',   'h', 'Height',  'I', 'Pad',
  258. X    'i', 'Ident',   'K', 'Config',  'k', 'Ignore',  'L', 'Left',
  259. X    'l', 'Labels',  'N', 'Nice',    'n', 'Namefile','O', 'AutoOff',
  260. X    'o', 'Offset',  'P', 'Suffix',  'p', 'Prefix',  'q', 'Quant',
  261. X    'Q', 'Qprog',   'r', 'Rows',    'S', 'Sort',    's', 'Silent',
  262. X    'T', 'Text',    't', 'Tempdir', 'u', 'Uniq',    'v', 'Verbose',
  263. X    'w', 'Width',   'X', 'Xsame',   'x', 'Xdim',    'Y', 'Ysame',
  264. X    'y', 'Ydim',    'z', 'Stripe',
  265. X);
  266. X
  267. X
  268. X#
  269. X# signal names (anybody got a better way to do this?)
  270. X#
  271. X
  272. Xif (-f '/vmunix') {
  273. X    # SunOS Release 4.1.2 Sun SPARCstation
  274. X    @signals = ('IMPOSSIBLE!', 'HUP', 'INT', 'QUIT', 'ILL', 'TRAP',
  275. X        'IOT', 'EMT', 'FPE', 'KILL', 'BUS', 'SEGV', 'SYS', 'PIPE',
  276. X        'ALRM', 'TERM', 'URG', 'STOP', 'TSTP', 'CONT', 'CHLD', 'TTIN',
  277. X        'TTOU', 'IO', 'XCPU', 'XFSZ', 'VTALRM', 'PROF', 'WINCH',
  278. X        'LOST', 'USR1', 'USR2');
  279. X
  280. X} else {
  281. X    # System V Release 3.2.1 AT&T 3B2 Version 3
  282. X    @signals = ('IMPOSSIBLE!', 'HUP', 'INT', 'QUIT', 'ILL', 'TRAP',
  283. X        'IOT', 'EMT', 'FPE', 'KILL', 'BUS', 'SEGV', 'SYS', 'PIPE',
  284. X        'ALRM', 'TERM', 'USR1', 'USR2', 'CLD', 'PWR', 'WINCH', 'PHONE',
  285. X        'POLL');
  286. X}
  287. X
  288. X
  289. X# ---------------------------- end of definitions -----------------------------
  290. X
  291. X
  292. X#
  293. X# keep track of the default settings for the usage message
  294. X#
  295. X
  296. Xfor (values(%optvar)) {
  297. X    $d{$_} = eval "\$$_";
  298. X}
  299. X
  300. X
  301. X#
  302. X# evaluate command line arguments before processing the 
  303. X# configuration file to pick up the -k and -K switches
  304. X#
  305. X
  306. X&evalargs(@ARGV);
  307. X
  308. X
  309. X#
  310. X# process the configuration file
  311. X#
  312. X
  313. Xunless ($Ignore) {
  314. X    local($home) = $ENV{'HOME'} || $ENV{'LOGDIR'} || (getpwuid($<))[7];
  315. X
  316. X    if ($home) {
  317. X        $home = '' if ($home eq '/');
  318. X        $Config =~ s|^~|$home|;
  319. X        if (-f $Config) {
  320. X            if (-e _) {
  321. X                if (open(CONFIG, "<$Config")) {
  322. X                    local($v, $f, $c, $line, @switches);
  323. X                    for ($line = 1; $_ = <CONFIG>; $line++) {
  324. X                        next if (/^\s*#/ || /^\s*$/);
  325. X                        s/#.*$//;
  326. X                        if (($f, $v) = /^\s*quantize\s+(\S+)\s+(\d+)\s*$/) {
  327. X                            $f =~ s/^\.//;
  328. X                            $defquant{$f} = $v;
  329. X                        } elsif (($f, $c) = /^\s*encode\s+(\S+)\s+(.*)\s*$/) {
  330. X                            $f =~ s/^\.//;
  331. X                            $encode{$f} = $c;
  332. X                        } elsif (($f, $c) = /^\s*decode\s+(\S+)\s+(.*)\s*$/) {
  333. X                            $f =~ s/^\.//;
  334. X                            $decode{$f} = $c;
  335. X                        } elsif (/^\s*switches\s+(.+)\s*$/) {
  336. X                            @switches = ();
  337. X                            $tail = $1;
  338. X                            $quoted = 0;
  339. X                            while ($tail) {
  340. X                                ($head, $tail) = split(/"/, $tail , 2);
  341. X                                push(@switches,
  342. X                                    $quoted ? $head : split(' ', $head));
  343. X                                $quoted = !$quoted;
  344. X                            }
  345. X                            while (@switches = &evalargs(@switches)) {
  346. X                                &warning('Ignoring `', shift @switches,
  347. X                                    "' on line $line of $Config");
  348. X                            }
  349. X                        } else {
  350. X                            &warning(
  351. X                                "can't understand line $line of `$Config'");
  352. X                        }
  353. X                    }
  354. X                    close CONFIG;
  355. X                } else {
  356. X                    &warning("can't open `$Config': $!!");
  357. X                }
  358. X            }
  359. X        } else {
  360. X            &warning("`$Config' is not a file!  Configuration file ignored.");
  361. X        }
  362. X    } else {
  363. X        &warning('can\'t find your home directory!  ',
  364. X            'Configuration file not found.');
  365. X    }
  366. X}
  367. X
  368. X
  369. X#
  370. X# evaluate command line arguments again after processing the
  371. X# configuration file so their values override (yes, this is ugly)
  372. X#
  373. X
  374. X@ARGV = &evalargs(@ARGV);
  375. X
  376. X
  377. X#
  378. X# tell the public who's responsible for this mess...
  379. X#
  380. X
  381. X&info("$program-$version $copyright $author") if $Verbose;
  382. X
  383. X
  384. X#
  385. X# assign $Tempdir
  386. X#
  387. X
  388. Xunless ($opt{'t'}) {
  389. X    if ($ENV{'TMPDIR'} && $ENV{'TEMPDIR'}) {
  390. X        &warning('both TMPDIR and TEMPDIR are set.  Using TMPDIR.');
  391. X    }
  392. X    $Tempdir = $ENV{'TMPDIR'} || $ENV{'TEMPDIR'} || $Tempdir;
  393. X}
  394. X
  395. X
  396. X#
  397. X# sanity checks (fatal)
  398. X#
  399. X
  400. X&fatal('no files specified!') unless @ARGV;
  401. X
  402. Xforeach $switch ('c', 'h', 'r', 'w', 'x', 'y') {
  403. X    $num = eval "\$$optvar{$switch}";
  404. X    if ($num !~ /^\d+$/ || $num < 1) {
  405. X        &fatal("-$switch argument must be a positive integer!");
  406. X    }
  407. X}
  408. X
  409. Xforeach $switch ('o', 'q') {
  410. X    $num = eval "\$$optvar{$switch}";
  411. X    if ($num !~ /^\d+$/ || $num < 0) {
  412. X        &fatal("-$switch argument must be non-negative integer!");
  413. X    }
  414. X}
  415. X
  416. Xif ($Nice) {
  417. X    unless ($Nice =~ /^-?\d+$/) {
  418. X        &fatal("your nice value must be an integer!")
  419. X    }
  420. X    if (($Nice < 0) && ($< != 0)) {
  421. X        &fatal("sorry, your nice value must be positive!");
  422. X    }
  423. X}
  424. X
  425. Xforeach ($Tempdir, $Dir) {
  426. X    $_ = '/' unless $_;
  427. X    &fatal("directory `$_' does not exist!") unless -e $_;
  428. X    &fatal("`$_' is not a directory!") unless -d _;
  429. X    &fatal("read permission denied on `$_'!") unless -r _;
  430. X    &fatal("write permission denied on `$_'!") unless -w _;
  431. X}
  432. X
  433. X&fatal("font file `$Font' does not exist!") if ($Font && !-e $Font);
  434. X&fatal("name file `$Namefile' does not exist!") if ($Namefile && !-e $Namefile);
  435. X
  436. X&fatal('-i and -X switches can\'t be used together.') if ($Ident && $Xsame);
  437. X&fatal('-i and -Y switches can\'t be used together.') if ($Ident && $Ysame);
  438. X&fatal('-X and -Y switches can\'t be used together.') if ($Xsame && $Ysame);
  439. X
  440. X&fatal('-O and -o switches can\'t be used together.')
  441. X    if ($opt{'o'} && $AutoOff);
  442. X
  443. X
  444. X#
  445. X# sanity checks (warnings)
  446. X#
  447. X
  448. Xif ($Auto) {
  449. X    &warning('image width is larger than sheet width!  ', 
  450. X        '(your sheets will be one image wide)') if ($Width > $Xdim);
  451. X    &warning('image height is larger than sheet height!  ', 
  452. X        '(your sheets will be one image high)') if ($Height > $Ydim);
  453. X    &warning('-r and -a specified!  Ignoring -r.') if $opt{'r'};
  454. X    &warning('-c and -a specified!  Ignoring -c.') if $opt{'c'};
  455. X} else {
  456. X    &warning('-x specified without -a!  Ignoring -x.') if $opt{'x'};
  457. X    &warning('-y specified without -a!  Ignoring -y.') if $opt{'y'};
  458. X}
  459. X
  460. Xif ($opt{'z'} && !$Borders) {
  461. X    &warning('-z specified without -B!  Ignoring -z.');
  462. X}
  463. X
  464. Xunless ($Labels) {
  465. X    &warning('-F specified without -l!  Ignoring -F.') if $Font;
  466. X    &warning('-b specified without -l!  Ignoring -b.') if $Base;
  467. X    &warning('-T specified without -l!  Ignoring -T.') if $opt{'T'};
  468. X}
  469. X
  470. X&warning('-I specified without -i!  Ignoring -I.') if ($opt{'I'} && !$Ident);
  471. X
  472. X&warning('-X and -h specified!  Ignoring -h.') if ($Xsame && $opt{'h'});
  473. X&warning('-Y and -w specified!  Ignoring -w.') if ($Ysame && $opt{'w'});
  474. X
  475. Xif ($Verbose && $Silent) {
  476. X    &warning('-v and -s cancel each other out!');
  477. X    $Silent = $Verbose = 0;
  478. X}
  479. X
  480. X
  481. X#
  482. X# strip leading dot from $DefFmt
  483. X#
  484. X
  485. X$DefFmt =~ s/^\.//;
  486. X
  487. X
  488. X#
  489. X# process output format
  490. X#
  491. X
  492. X$Format =~ s/^\.//;
  493. X
  494. X@suffs = split(/\./, $Format);
  495. X
  496. Xif (@badext = grep(!defined($encode{$_}), @suffs)) {
  497. X    &fatal(sprintf('unrecognized extension%s (%s) in output format!',
  498. X        ((@badext > 1) ? 's' : ''), &cslist(@badext)));
  499. X}
  500. X
  501. X@encodecmd = grep($_, @encode{@suffs});
  502. X
  503. X$Quant = $defquant{$Format} if (!$opt{'q'} && $defquant{$Format});
  504. X
  505. Xunshift(@encodecmd, "$Qprog $Quant") if $Quant;
  506. X
  507. X$encodecmd = @encodecmd ? ('| ' . join(' | ', @encodecmd) . ' ') : '';
  508. X
  509. X
  510. X#
  511. X# get filenames from named file
  512. X#
  513. X
  514. X@filelist = ();
  515. X
  516. Xif ($Namefile) {
  517. X    open(NAMEFILE, "<$Namefile") ||
  518. X        &fatal("unable to open `$Namefile' to read filenames: $!!");
  519. X    chop(@filelist = <NAMEFILE>);
  520. X    close(NAMEFILE);
  521. X}
  522. X
  523. Xunshift(@filelist, @ARGV);
  524. X
  525. X&fatal('no files specified!') unless @filelist;
  526. X
  527. Xif ($Xsame) {
  528. X    $pnmscale = "pnmscale -xsize $Width";
  529. X} elsif ($Ysame) {
  530. X    $pnmscale = "pnmscale -ysize $Height";
  531. X} else {
  532. X    $pnmscale = "pnmscale -xysize $Width $Height";
  533. X}
  534. X
  535. X
  536. X#
  537. X# start up the signal handler.
  538. X#
  539. X
  540. X@tfie = ();
  541. X
  542. X$SIG{'HUP'} = $SIG{'INT'} = $SIG{'QUIT'} = $SIG{'TERM'} = 'catcher';
  543. X
  544. X
  545. X#
  546. X# look for and process parameter files
  547. X#
  548. X
  549. X$Suffix =~ s/^\.//;
  550. X
  551. X@newlist = ();
  552. X$pcount = 1;
  553. X
  554. Xforeach $file (@filelist) {
  555. X    if ($file !~ /\.$Suffix$/) {
  556. X        push(@newlist, $file);
  557. X        next;
  558. X    }
  559. X
  560. X    unless (open(PARAM, "<$file")) {
  561. X        &skip("can't open `$file' for reading: $!!");
  562. X        next;
  563. X    }
  564. X    
  565. X    local($fn, @xywh, $line);
  566. X    for ($line = 1; $_ = <PARAM>; $line++) {
  567. X        next if (/^\s*#/ || /^\s*$/);
  568. X        s/#.*$//;
  569. X        if (($fn, @xywh) = /^\s*(\S+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s*$/) {
  570. X            push(@newlist, $fn);
  571. X            $esheetname{$fn} = "$Tempdir/icp$pcount-$$";
  572. X            $parameters{$fn} = "@xywh";
  573. X            ($sheetname{$fn} = $file) =~ s/\.$Suffix$//;
  574. X        } else {
  575. X            &warning("can't understand line $line of `$file'!");
  576. X        }
  577. X    }
  578. X    close(PARAM);
  579. X    $pcount++;
  580. X}
  581. X@filelist = @newlist;
  582. X
  583. X
  584. X#
  585. X# take the basename's once and for all.
  586. X#
  587. X
  588. Xforeach (@filelist, values(%sheetname)) {
  589. X    $basename{$_} = (/([^\/]*)$/ ? $1 : $_);
  590. X}
  591. X
  592. X
  593. X#
  594. X# uniq filenames
  595. X#
  596. X
  597. Xif ($Uniq) {
  598. X    local(%seen) = @newlist = ();
  599. X    foreach (@filelist) {
  600. X        if ($seen{$Base ? $basename{$_} : $_}++) {
  601. X            &info("removing duplicate `$_' from file list");
  602. X            $esheetname{$_} = '';       # use the one that's not shrunk already.
  603. X        } else {
  604. X            push(@newlist, $_);
  605. X        }
  606. X    }
  607. X    @filelist = @newlist;
  608. X}
  609. X
  610. X
  611. X#
  612. X# sort filenames
  613. X#
  614. X
  615. X@filelist = ($Base ? sort by_basename @filelist : sort @filelist) if $Sort;
  616. X
  617. X
  618. X#
  619. X# figure out how big a character is in the specified font
  620. X#
  621. X
  622. Xif ($Labels) {
  623. X    $pbmtext = 'pbmtext' . ($Font ? " -font '$Font'" : '');
  624. X    open(TEXT, "$pbmtext 'M' | pnmfile |") || 
  625. X        &fatal("can't open `$pbmtext' to determine font size for labels: $!!");
  626. X
  627. X    (<TEXT> =~ /\s+(\d+)\s+by\s+(\d+)\s+/) ||
  628. X        &fatal("can't understand `$pbmtext 'M' | pnmfile |' output!");
  629. X
  630. X    close(TEXT);
  631. X
  632. X    $cwidth = int($1 / 3);
  633. X    $cheight = $2;
  634. X
  635. X    if (($Text eq 'black') && ($Back eq 'white')) {
  636. X        $colorize = '';
  637. X    } elsif (($Text eq 'white') && ($Back eq 'black')) {
  638. X        $colorize = " | pnminvert";
  639. X    } else {
  640. X        $colorize = " | pnmdepth 255 | pgmtoppm $Text-$Back";
  641. X    }
  642. X}
  643. X
  644. X
  645. X#
  646. X# determine the offset to be used for the first sheet.
  647. X#
  648. X
  649. Xif ($opt{'o'}) {
  650. X    $scount = $Offset;
  651. X} elsif ($AutoOff) {
  652. X    opendir(DESTDIR, $Dir) ||
  653. X        &fatal("can't open destination directory to find offset: $!!");
  654. X
  655. X    local($last) =
  656. X        reverse sort grep(/^$Prefix([0-9]{3,})\.$Format$/, readdir(DESTDIR));
  657. X
  658. X    closedir(DESTDIR);
  659. X
  660. X    if ($last) {
  661. X        $last =~ /^$Prefix([0-9]{3,})\.$Format$/;
  662. X        $scount = $1 + 1;
  663. X    } else {
  664. X        $scount = 1;
  665. X    }
  666. X} else {
  667. X    $scount = 1;
  668. X}
  669. X
  670. X
  671. X#
  672. X# figure out what color borders to use
  673. X#
  674. X
  675. X$stripes = @stripe = split(' ', $Stripe) if $Borders;
  676. X
  677. X
  678. X#
  679. X# a few initializations...
  680. X#
  681. X
  682. X$jl = $Left ? ' -jl' : '';
  683. X
  684. X$temp = "$Tempdir/ict-$$";
  685. X$backtemp = "$Tempdir/icc-$$";
  686. X
  687. X$icount = $rcount = 1;
  688. X
  689. X$iqwidth = $iqheight = $rqheight = 0;
  690. X
  691. X@ipqueue = @fpqueue = @rpqueue = ();
  692. X
  693. X
  694. X#
  695. X# create one pad file for all the images if $Ident
  696. X#
  697. X
  698. Xif ($Ident) {
  699. X    $pad = "$Tempdir/ice-$$";
  700. X
  701. X    $command = "ppmmake $Pad $Width $Height > $pad";
  702. X
  703. X    &shell($command) || &fatal('unable to create pad file!');
  704. X}
  705. X
  706. X
  707. X#
  708. X# create one border file for all the images if $Ident && $Borders
  709. X#
  710. X
  711. Xif ($Borders && $Ident) {
  712. X    $border = "$Tempdir/icb-$$";
  713. X
  714. X    local($count) = 2;
  715. X
  716. X    $command = sprintf('ppmmake %s %d %d > %s',
  717. X        $stripe[$[], ($Width + $count), ($Height + $count), $border);
  718. X
  719. X    &shell($command) || &fatal('unable to create border file!');
  720. X
  721. X    foreach $color (@stripe[$[+1..$#stripe]) {
  722. X        $count += 2;
  723. X
  724. X        $command = sprintf('ppmmake %s %d %d | pnmpaste %s 1 1 > %s',
  725. X            $color, ($Width + $count), ($Height + $count), $border, $temp);
  726. X
  727. X        &shell($command) || &fatal('unable to add a layer to border file!');
  728. X
  729. X        &mv($temp, $border);
  730. X    }
  731. X}
  732. X
  733. X
  734. X#
  735. X# process each file
  736. X#
  737. X
  738. XIMAGE: while ($file = shift @filelist) {
  739. X    $image = "$Tempdir/ici$icount-$$";
  740. X
  741. X    if ($sheetname{$file}) {
  742. X        # file is to be cut from sheet
  743. X
  744. X        unless (grep(/^$esheetname{$file}$/, @tfie)) {
  745. X            &toppm($sheetname{$file}, $esheetname{$file}, 0) || next IMAGE;
  746. X        }
  747. X        &cut($file, $image) || next IMAGE;
  748. X        &rm($esheetname{$file}) unless
  749. X            grep(/^$esheetname{$file}$/, @esheetname{@filelist});
  750. X    } else {
  751. X        # file is an image file
  752. X
  753. X        unless (-e $file) {
  754. X            &skip("`$file' does not exist!");
  755. X            next IMAGE;
  756. X        }
  757. X        unless (-f _) {
  758. X            &skip("`$file' is not a file!");
  759. X            next IMAGE;
  760. X        }
  761. X        &toppm($file, $image, 1) || next IMAGE;
  762. X    }
  763. X
  764. X    $label = ($Base ? $basename{$file} : $file);
  765. X
  766. X    if ($Auto || $Labels || $Borders || $Param || $Ident) {
  767. X        unless (open(SIZE, "pnmfile $image |")) {
  768. X            &skip("can't open `pnmfile $image |' for reading: $!!");
  769. X            &rm($image);
  770. X            next IMAGE;
  771. X        }
  772. X        unless ((($iwidth, $iheight) =
  773. X            (<SIZE> =~ /\s+(\d+)\s+by\s+(\d+)\s+/))) {
  774. X            &skip("can't understand `pnmfile $image |' output!");
  775. X            &rm($image);
  776. X            close(SIZE);
  777. X            next IMAGE;
  778. X        }
  779. X        close(SIZE);
  780. X
  781. X        ($zxoff, $zyoff, $ziwidth, $ziheight) = (0, 0, $iwidth, $iheight)
  782. X            if $Param;
  783. X    }
  784. X
  785. X    if ($Ident) {
  786. X        $xpad = int(($Width - $iwidth) / 2);
  787. X        $ypad = int(($Height - $iheight) / 2);
  788. X
  789. X        $command = sprintf('pnmpaste %s %d %d %s > %s', $image, $xpad, $ypad,
  790. X            $pad, $temp);
  791. X
  792. X        unless (&shell($command)) {
  793. X            &skip("unable to pad `$file' to ${Width}x$Height!");
  794. X            &rm($image, $temp);
  795. X            next IMAGE;
  796. X        }
  797. X
  798. X        &mv($temp, $image);
  799. X
  800. X        $iwidth = $Width;
  801. X        $iheight = $Height;
  802. X
  803. X        if ($Param) {
  804. X            $zxoff += $xpad;
  805. X            $zyoff += $ypad;
  806. X        }
  807. X
  808. X    }
  809. X
  810. X    if ($Borders) {
  811. X        if ($Ident) {
  812. X            $iwidth += $stripes * 2;
  813. X            $iheight += $stripes * 2;
  814. X
  815. X            $command = sprintf('pnmpaste %s %d %d %s > %s', $image, $stripes,
  816. X                $stripes, $border, $temp);
  817. X
  818. X            unless (&shell($command)) {
  819. X                &skip("unable to add a border to `$file'!");
  820. X                &rm($image, $temp);
  821. X                next IMAGE;
  822. X            }
  823. X
  824. X            &mv($temp, $image);
  825. X        } else {
  826. X            foreach $color (@stripe) {
  827. X                $iwidth += 2;
  828. X                $iheight += 2;
  829. X
  830. X                $command = sprintf('ppmmake %s %d %d | pnmpaste %s 1 1 > %s',
  831. X                    $color, $iwidth, $iheight, $image, $temp);
  832. X
  833. X                unless (&shell($command)) {
  834. X                    &skip("unable to add a layer of border on `$file'!");
  835. X                    &rm($image, $temp);
  836. X                    next IMAGE;
  837. X                }
  838. X
  839. X                &mv($temp, $image);
  840. X            }
  841. X        }
  842. X
  843. X        if ($Param) {
  844. X            $zxoff += $stripes;
  845. X            $zyoff += $stripes;
  846. X        }
  847. X    }
  848. X
  849. X    if ($Labels) {
  850. X        $slots = int($iwidth / $cwidth);
  851. X
  852. X        if (($Back eq 'black') || ($Back eq 'white')) {
  853. X            $padlabel = '';
  854. X            $bg = "-$Back ";
  855. X        } else {
  856. X            $command = sprintf('ppmmake %s %s %s > %s', $Back, $iwidth,
  857. X                $cheight, $backtemp);
  858. X            unless (&shell($command)) {
  859. X                &skip("unable to create color label pad for `$file'!");
  860. X                &rm($image, $backtemp);
  861. X                next IMAGE;
  862. X            }
  863. X            if (($slots - length($label)) >= 2) {
  864. X                $over = int(($iwidth - $cwidth * (length($label) + 2)) / 2);
  865. X            } else {
  866. X                $over = int(($iwidth - $cwidth * $slots) / 2);
  867. X            }
  868. X            $padlabel = " | pnmpaste - $over 0 $backtemp";
  869. X            $bg = '';
  870. X        }
  871. X
  872. X        if (($slots - length($label)) >= 2) {
  873. X            $command = sprintf('%s \'%s\'%s%s | pnmcat %s-tb %s - > %s',
  874. X                $pbmtext, $label, $colorize, $padlabel,
  875. X                $bg, $image, $temp);
  876. X        } else {
  877. X            $command = sprintf(
  878. X                '%s \'%s\'%s | pnmcut %d 0 %d %d%s | pnmcat %s-tb %s - > %s',
  879. X                $pbmtext, substr($label, 0, $slots), $colorize,
  880. X                $cwidth, ($cwidth * $slots), $cheight, $padlabel,
  881. X                $bg, $image, $temp);
  882. X        }
  883. X
  884. X        unless (&shell($command)) {
  885. X            &skip("unable to attach label to `$file'!");
  886. X            &rm($image, $temp);
  887. X            next IMAGE;
  888. X        }
  889. X
  890. X        &mv($temp, $image);
  891. X
  892. X        $iheight += $cheight;
  893. X    }
  894. X
  895. X    if ($Auto) {
  896. X        if ($iqwidth + $iwidth > $Xdim) {
  897. X            if (@iqueue) {
  898. X                &image2row;
  899. X                $rcount++;
  900. X                $wrheight = $iqheight;
  901. X                &pushimage;
  902. X                ($iqwidth, $iqheight) = ($iwidth, $iheight);
  903. X            } else {
  904. X                &pushimage;
  905. X                &image2row;
  906. X                $rcount++;
  907. X                $wrheight = $iheight;
  908. X                $iqwidth = $iqheight = 0;
  909. X            }
  910. X            if ($rqheight + $wrheight > $Ydim) {
  911. X                if (@rqueue) {
  912. X                    &row2sheet;
  913. X                    &pushrow;
  914. X                    $rqheight = $wrheight;
  915. X                } else {
  916. X                    &pushrow;
  917. X                    &row2sheet;
  918. X                    $rqheight = 0;
  919. X                }
  920. X            } else {
  921. X                &pushrow;
  922. X                $rqheight += $wrheight;
  923. X            }
  924. X        } else {
  925. X            &pushimage;
  926. X            $iqwidth += $iwidth;
  927. X            $iqheight = $iheight if ($iheight > $iqheight);
  928. X        }
  929. X    } else {
  930. X        &pushimage;
  931. X        if (($icount % $Columns) == 0) {
  932. X            &image2row;
  933. X            &pushrow;
  934. X            &row2sheet if (($rcount % $Rows) == 0);
  935. X            $rcount++;
  936. X        }
  937. X    }
  938. X
  939. X    $icount++;
  940. X}
  941. X
  942. Xif (@iqueue) {
  943. X    &image2row;
  944. X    &row2sheet if ($Auto && $rqheight + $iqheight > $Ydim);
  945. X    &pushrow;
  946. X}
  947. X&row2sheet if @rqueue;
  948. X
  949. X&cleanup;
  950. X
  951. Xexit(0);        
  952. X
  953. X&catcher('IMPOSSIBLE!');    # just to get rid of the warning...
  954. X
  955. X
  956. X# --------------------------- end of main program -----------------------------
  957. X
  958. X
  959. Xsub by_basename {
  960. X    $basename{$a} cmp $basename{$b};
  961. X}
  962. X
  963. X
  964. Xsub by_number {
  965. X    $a <=> $b;
  966. X}
  967. X
  968. X
  969. Xsub catcher {
  970. X    local($name) = @_;
  971. X    &fatal("caught a SIG$name -- shutting down!");
  972. X}
  973. X
  974. X
  975. Xsub cleanup {
  976. X    &rm(@tfie);
  977. X}
  978. X
  979. X
  980. Xsub cslist {
  981. X    local($") = ', ';
  982. X    "@_";
  983. X}
  984. X
  985. X
  986. Xsub cut {
  987. X    local($input, $output) = @_;
  988. X
  989. X    &info("cutting `$input'");
  990. X    if (!&shell("pnmcut $parameters{$input} $esheetname{$input} > $output")) {
  991. X        &skip("can't cut from $esheetname{$input}");
  992. X        &rm($output);
  993. X        return 0;
  994. X    }
  995. X    return 1;
  996. X}
  997. X
  998. X
  999. Xsub evalargs {
  1000. X    local(@args) = @_;
  1001. X
  1002. X    while ($_ = $args[0], ($_ && /^[-+]/)) {
  1003. X        shift @args;
  1004. X        last if /^--$/;
  1005. X
  1006. X        if (/^[-+]help$/) {                                 # special case
  1007. X            &usage;
  1008. X        } elsif (/^[-+]([CcDdFfhIKNnoPpQqrTtwxyz])$/) {     # argument
  1009. X            if (@args) {
  1010. X                eval "\$opt{'$1'} = 1; \$$optvar{$1} = shift \@args";
  1011. X            } else {
  1012. X                &fatal("no argument given for -$1 switch!");
  1013. X            }
  1014. X        } elsif (/^([-+])([aBbgikLlOSsuvXY])(.*)$/) {       # no argument
  1015. X            $val = ($1 eq '-');
  1016. X            $backon = length($3) ? "; unshift(\@args, '$1$3')" : '';
  1017. X            eval "\$$optvar{$2} = $val$backon";
  1018. X        } else {                                            # unrecognized
  1019. X            warn "$program: FATAL ERROR: unrecognized switch: `$_'!\n";
  1020. X            &usage;
  1021. X        }
  1022. X    }
  1023. X    @args;
  1024. X}
  1025. X
  1026. X
  1027. Xsub fatal {
  1028. X    &cleanup;
  1029. X    die "$program: FATAL ERROR: ", @_, "\n";
  1030. X}
  1031. X
  1032. X
  1033. Xsub image2row {
  1034. X    $row = "$Tempdir/icr$rcount-$$";
  1035. X    &info("assembling row $rcount");
  1036. X
  1037. X    if ($Back eq 'black' || $Back eq 'white') {
  1038. X        $bg = "-$Back ";
  1039. X    } else {
  1040. X        local($tallest, $h, $w, $i);
  1041. X
  1042. X        $tallest = -1;
  1043. X        foreach (@ipqueue) {
  1044. X            $h = (unpack('A255I7', $_))[3];
  1045. X            $tallest = $h if ($h > $tallest);
  1046. X        }
  1047. X
  1048. X        for($i = 0; $i < @iqueue; $i++) {
  1049. X            ($w, $h) = (unpack('A255I7', $ipqueue[$i]))[2..3];
  1050. X            if ($h < $tallest) {
  1051. X                $command = sprintf('ppmmake %s %d %d | pnmcat -tb - %s > %s',
  1052. X                    $Back, $w, $tallest - $h,
  1053. X                    $iqueue[$i], $backtemp);
  1054. X                if (&shell($command)) {
  1055. X                    &mv($backtemp, $iqueue[$i]);
  1056. X                } else {
  1057. X                    &warning("can't add color padding to $iqueue[$i]!");
  1058. X                    &rm($backtemp);
  1059. X                }
  1060. X            }
  1061. X        }
  1062. X        $bg = '';
  1063. X    }
  1064. X
  1065. X    if (&shell("pnmcat $bg-lr -jb @iqueue > $row")) {
  1066. X        if ($Param) {
  1067. X            push(@fpqueue, @ipqueue);
  1068. X            @ipqueue = ();
  1069. X        }
  1070. X    } else {
  1071. X        &skip("can't assemble row $rcount!");
  1072. X        &rm($row);
  1073. X    }
  1074. X    &rm(@iqueue);
  1075. X    @iqueue = ();
  1076. X}
  1077. X
  1078. X
  1079. Xsub info {
  1080. X    warn "$program: ", @_, "\n" unless $Silent;
  1081. X}
  1082. X
  1083. X
  1084. Xsub mv {
  1085. X    local($src, $dest) = @_;
  1086. X
  1087. X    &info("moving $src to $dest") if $Verbose;
  1088. X
  1089. X    unless (rename($src, $dest)) {
  1090. X        &fatal("unable to move `$src' to `$dest': $!!");
  1091. X    }
  1092. X
  1093. X    &tfdelete($src);
  1094. X    &tfadd($dest);
  1095. X}
  1096. X
  1097. X
  1098. Xsub on {
  1099. X    local($num) = @_;
  1100. X
  1101. X    $num ? 'on' : 'off';
  1102. X}
  1103. X
  1104. X
  1105. Xsub pushimage {
  1106. X    push(@iqueue, $image);
  1107. X    push(@ipqueue, pack('A255I7', $label, $rcount, $iwidth, $iheight,
  1108. X        $zxoff, $zyoff, $ziwidth, $ziheight)) if $Param;
  1109. X}
  1110. X
  1111. X
  1112. Xsub pushrow {
  1113. X    push(@rqueue, $row);
  1114. X    if ($Param) {
  1115. X        push(@rpqueue, @fpqueue);
  1116. X        @fpqueue = ();
  1117. X    }
  1118. X}
  1119. X
  1120. X
  1121. Xsub rm {
  1122. X    local(@tbd) = @_;
  1123. X
  1124. X    &info('unlinking ', &cslist(@tbd)) if (@tbd && $Verbose);
  1125. X
  1126. X    foreach (@tbd) {
  1127. X        &tfdelete($_);
  1128. X        &warning("can't unlink `$_': $!!") unless unlink($_);
  1129. X    }
  1130. X}
  1131. X
  1132. X
  1133. Xsub row2sheet {
  1134. X    local($sheet) = sprintf('%s/%s%03d.%s', $Dir, $Prefix, $scount, $Format);
  1135. X    &info("assembling `$sheet'");
  1136. X
  1137. X    if (($Back eq 'black') || ($Back eq 'white')) {
  1138. X        $bg = "-$Back ";
  1139. X    } else {
  1140. X        local(%width, %height, $widest, $r, $h, $w, $i, $f);
  1141. X
  1142. X        $f = 0;
  1143. X        foreach (@rpqueue) {
  1144. X            ($r, $w, $h) = (unpack('A255I7', $_))[1..3];
  1145. X            $f = $r unless $f;
  1146. X            $width{$r} = $width{$r} ? ($width{$r} + $w) : $w;
  1147. X            $height{$r} = $h if (!$height{$r} || $h > $height{$r});
  1148. X        }
  1149. X        ($widest) = reverse sort by_number values(%width);
  1150. X
  1151. X        for($i = 0; $i < @rqueue; $i++) {
  1152. X            if ($width{$f + $i} < $widest) {
  1153. X                $command = sprintf('ppmmake %s %d %d | pnmpaste %s %d 0 - > %s',
  1154. X                    $Back, $widest, $height{$f + $i},
  1155. X                    $rqueue[$i],
  1156. X                    ($Left ? 0 : int(($widest - $width{$f + $i}) / 2)),
  1157. X                        $backtemp);
  1158. X                if (&shell($command)) {
  1159. X                    &mv($backtemp, $rqueue[$i]);
  1160. X                } else {
  1161. X                    &warning("can't add color padding to $rqueue[$i]!");
  1162. X                    &rm($backtemp);
  1163. X                }
  1164. X            }
  1165. X        }
  1166. X        $bg = '';
  1167. X    }
  1168. X
  1169. X    if (&shell("pnmcat $bg-tb$jl @rqueue $encodecmd> $sheet")) {
  1170. X
  1171. X        &tfdelete($sheet);  # save the sheets!
  1172. X
  1173. X        if ($Param) {
  1174. X            local($pfile) = "$sheet.$Suffix";
  1175. X            &info("creating `$pfile'");
  1176. X            if (open(PARAM, ">$pfile")) {
  1177. X                local(%height, %width, $r, $h, $w, $n, $zx, $zy, $zw, $zh);
  1178. X
  1179. X                foreach (@rpqueue) {
  1180. X                    ($r, $w, $h) = (unpack('A255I7', $_))[1..3];
  1181. X                    $width{$r} = $width{$r} ? ($width{$r} + $w) : $w;
  1182. X                    $height{$r} = $h if (!$height{$r} || $h > $height{$r});
  1183. X                }
  1184. X
  1185. X                local($xoff);
  1186. X                local($yoff) = 0;
  1187. X                local($pastr) = -1;
  1188. X                local($widest) = reverse sort by_number values(%width);
  1189. X
  1190. X                foreach (@rpqueue) {
  1191. X                    ($n, $r, $w, $h, $zx, $zy, $zw, $zh) = unpack('A255I7', $_);
  1192. X                    if ($r != $pastr) {
  1193. X                        $pastr = $r;
  1194. X                        $xoff = 0;
  1195. X                        $yoff += $height{$r};
  1196. X                    }
  1197. X                    printf(PARAM "%-40s %5d %5d %5d %5d\n", $n,
  1198. X                        ($Left ? 0 : int(($widest - $width{$r}) / 2)) +
  1199. X                            $xoff + $zx, $yoff - $h + $zy, $zw, $zh);
  1200. X                    $xoff += $w;
  1201. X                }
  1202. X
  1203. X                @rpqueue = ();
  1204. X                close(PARAM);
  1205. X            } else {
  1206. X                &warning("can't open `$pfile' for writing: $!!");
  1207. X            }
  1208. X        }
  1209. X    } else {
  1210. X        &skip("can't assemble sheet $scount!");
  1211. X        &rm($sheet);
  1212. X    }
  1213. X    $scount++;
  1214. X    &rm(@rqueue);
  1215. X    @rqueue = ();
  1216. X}
  1217. X
  1218. X
  1219. Xsub shell {
  1220. X    local($command) = @_;
  1221. X
  1222. X    &tfadd($1) if ($command =~ /\s+>\s+(\S+)$/);
  1223. X
  1224. X    $command = "nice -$Nice " . $command if $Nice;
  1225. X
  1226. X    if ($Verbose) {
  1227. X        &info($command);
  1228. X    } else {
  1229. X        $command = "($command) 2> /dev/null";
  1230. X    }
  1231. X
  1232. X    system $command;
  1233. X
  1234. X    if ($? & 255) {
  1235. X        &warning("`$command' was killed by a SIG", @signals[$? & 127], '!', 
  1236. X            ($? & 128) ? '  core dumped.' : '');
  1237. X        return 0;
  1238. X    } elsif ($status = ($? >> 8)) {
  1239. X        if ($status & 128) {
  1240. X            local($message) = "`$command' was terminated abnormally by a SIG" .
  1241. X                    @signals[$status & 127] . '!';
  1242. X
  1243. X            # treat SIGINT differently to allow
  1244. X            # the user to stop icontact easily
  1245. X
  1246. X            if (($status & 127) == 2) {
  1247. X                &fatal($message);
  1248. X            } else {
  1249. X                &warning($message);
  1250. X                return 0;
  1251. X            }
  1252. X        } else {
  1253. X            &warning("`$command' terminated with exit status: $status!");
  1254. X            return 0;
  1255. X        }
  1256. X    }
  1257. X    1;
  1258. X}
  1259. X
  1260. X
  1261. Xsub skip {
  1262. X    &warning(@_, '  Skipping.');
  1263. X}
  1264. X
  1265. X
  1266. Xsub tfadd {
  1267. X    local($temporary) = @_;
  1268. X    push(@tfie, $temporary) unless grep(/^$temporary$/, @tfie);
  1269. X}
  1270. X
  1271. X
  1272. Xsub tfdelete {
  1273. X    local($temporary) = @_;
  1274. X    @tfie = grep(!/^$temporary$/, @tfie);
  1275. X}
  1276. X
  1277. X
  1278. Xsub toppm {
  1279. X    local($input, $output, $shrink) = @_;
  1280. X
  1281. X    local(@suffs) = split(/\./, $basename{$input});
  1282. X    shift @suffs;
  1283. X
  1284. X    if (@badext = grep(!defined($decode{$_}), @suffs)) {
  1285. X        &warning(sprintf('unrecognized extension%s (%s) on `%s\'!',
  1286. X            ((@badext > 1) ? 's' : ''), &cslist(@badext), $input));
  1287. X
  1288. X        if (@suffs = grep(defined($decode{$_}), @suffs)) {
  1289. X            &warning(sprintf('Assuming `%s\' is a `.%s\' file.',
  1290. X                $input, join('.', @suffs)));
  1291. X        }
  1292. X    }
  1293. X
  1294. X    unless (@suffs) {
  1295. X        &warning("no extension on `$input'!",
  1296. X            "  Assuming it is a `.$DefFmt' file.");
  1297. X        @suffs = ($DefFmt);
  1298. X    }
  1299. X
  1300. X    local(@decodecmd) = grep($_, reverse @decode{@suffs});
  1301. X
  1302. X    local($init) = (@decodecmd && ($decodecmd[0] =~ tr/|/|/) == 0) ?
  1303. X        (shift @decodecmd) . " '$input'" : "cat '$input'";
  1304. X
  1305. X    local($decodecmd);
  1306. X    if ($shrink) {
  1307. X        $decodecmd = join(' | ', ($init, @decodecmd, "$pnmscale > $output"));
  1308. X        &info("shrinking `$input'");
  1309. X    } else {
  1310. X        $decodecmd = join(' | ', ($init, @decodecmd)) . " > $output";
  1311. X        &info("expanding `$input'");
  1312. X    }
  1313. X
  1314. X    unless (&shell($decodecmd)) {
  1315. X        &skip("can't decode `$input'!");
  1316. X        &rm($output);
  1317. X        return 0;
  1318. X    }
  1319. X    1;
  1320. X}
  1321. X
  1322. X
  1323. Xsub usage {
  1324. X    die "usage: $program [switches] [{image file | parameter file} ...]
  1325. X[switches] consist of:
  1326. X-a, +a\t automatically size sheets to the size of the screen.  default = ",
  1327. X    &on($d{'Auto'}), "
  1328. X-B, +B\t put borders around each image.  default = ", &on($d{'Borders'}), "
  1329. X-b, +b\t take the basename of the filenames.  default = ", &on($d{'Base'}), "
  1330. X-C color color of the background.  default = `$d{'Back'}' 
  1331. X-c #\t number of columns of images in each sheet.  default = $d{'Columns'}
  1332. X-D suff\t use `suff' as the file format if image has no suffix.  default = `",
  1333. X    $d{'DefFmt'}, "'
  1334. X-d dir\t put sheets in `dir'.  default = `$d{'Dir'}'
  1335. X-f suff\t use `suff' as the file format of the sheets.  default = `$d{'Format'}'
  1336. X-F file\t font file for labels.  default = `",
  1337. X    ($d{'Font'} || 'pbmtext\'s internal font'), "'
  1338. X-g, +g\t generate parameter files for sheets.  default = ", &on($d{'Param'}), "
  1339. X-h #\t height of each small image in pixels.  default = $d{'Height'}
  1340. X-I color color of the area around images when using -i.  default = `$d{'Pad'}'
  1341. X-i, +i\t make images the same size.  default = ", &on($d{'Ident'}), "
  1342. X-K file\t use `file' as the configuration file.  default = `$d{'Config'}'
  1343. X-k, +k\t don't reference the configuration file.  default = ",
  1344. X    &on($d{'Ignore'}), "
  1345. X-l, +l\t put labels under the images.  default = ", &on($d{'Labels'}), "
  1346. X-L, +L\t left justify all the rows.  default = ", &on($d{'Left'}), "
  1347. X-N #\t run child processes at this nice value.  default = $d{'Nice'}
  1348. X-n file\t get filenames from `file'.  default = none
  1349. X-O, +O\t find the number for the first sheet automatically.  default = ",
  1350. X    &on($d{'AutoOff'}), "
  1351. X-o #\t start at this number when naming sheets.  default = $d{'Offset'}
  1352. X-P suff\t suffix of parameter files.  default = `$d{'Suffix'}'
  1353. X-p name\t name of the sheets. default = `$d{'Prefix'}'
  1354. X-Q prog\t the quantization program.  default = `$d{'Qprog'}'
  1355. X-q #\t number of colors in each sheet.  default = $d{'Quant'}
  1356. X-r #\t number of rows of images in each sheet.  default = $d{'Rows'}
  1357. X-S, +S\t sort all the filenames.  default = ", &on($d{'Sort'}), "
  1358. X-s, +s\t be silent.  default = ", &on($d{'Silent'}), "
  1359. X-T color color of label text.  default = `$d{'Text'}'
  1360. X-t dir\t use `dir' to hold temporary files.  default = `$d{'Tempdir'}'
  1361. X-u, +u\t remove duplicate file names from file list.  default = ",
  1362. X    &on($d{'Uniq'}), "
  1363. X-v, +v\t be verbose.  default = ", &on($d{'Verbose'}), "
  1364. X-w #\t width of each small image in pixels.  default = $d{'Width'}
  1365. X-X, +X\t make images the same width.  default = ", &on($d{'Ysame'}), "
  1366. X-x #\t screen width in pixels.  default = $d{'Xdim'}
  1367. X-Y, +Y\t make images the same height.  default = ", &on($d{'Ysame'}), "
  1368. X-y #\t screen height in pixels.  default = $d{'Ydim'}
  1369. X-z list\t list of colors for border stripes.  default = `$d{'Stripe'}'
  1370. X";
  1371. X}
  1372. X
  1373. X
  1374. Xsub warning {
  1375. X    warn "$program: WARNING: ", @_, "\n";
  1376. X}
  1377. END_OF_FILE
  1378. if test 38651 -ne `wc -c <'icontact'`; then
  1379.     echo shar: \"'icontact'\" unpacked with wrong size!
  1380. fi
  1381. chmod +x 'icontact'
  1382. # end of 'icontact'
  1383. fi
  1384. echo shar: End of archive 2 \(of 2\).
  1385. cp /dev/null ark2isdone
  1386. MISSING=""
  1387. for I in 1 2 ; do
  1388.     if test ! -f ark${I}isdone ; then
  1389.     MISSING="${MISSING} ${I}"
  1390.     fi
  1391. done
  1392. if test "${MISSING}" = "" ; then
  1393.     echo You have unpacked both archives.
  1394.     rm -f ark[1-9]isdone
  1395. else
  1396.     echo You still need to unpack the following archives:
  1397.     echo "        " ${MISSING}
  1398. fi
  1399. ##  End of shell archive.
  1400. exit 0
  1401.  
  1402. exit 0 # Just in case...
  1403.