[Coco] perl script to convert pics for Sockmaster's Hicolor prog

[Steve Bjork]

I've been using ImageMagick  (www.imagemagick.org) for sometime on my 
servers to resize images uploaded by users.

here is some code in Perl to resize the an image:

my($image, $x);

$image = Image::Magick->new;
$x = $image->Read($PathToImages.'post/'.$file_name);

($Xsize,$Ysize)= $image->Get('columns','height');
$Xsize=0.0+$Xsize;
$Ysize=0.0+$Ysize;

$f=0.0;
$sizeit=0;
if ($Xsize>$MaxPostXsize){
         $f=($MaxPostXsize+0.0)/($Xsize+0.0);
         $Xsize=int(0.49+$Xsize*$f)+0.0;
         $Ysize=int(0.49+$Ysize*$f)+0.0;
         $sizeit++;
         }
if ($Ysize>$MaxPostYsize){
         $f=($MaxPostYsize+0.0)/($Ysize+0.0);
         $Xsize=int(0.49+$Xsize*$f)+0.0;
         $Ysize=int(0.49+$Ysize*$f)+0.0;
         $sizeit++
         }

if ($sizeit){
         $x=$image->Scale(geometry => "$Xsize x $Ysize");
         if ($x) {print $x,"<br>\n";}
         $x = $image->Write($PathToImages.'post/'.$file_name);
         if ($x) {print $x,"<br>\n";}
         ($Xsize,$Ysize)= $image->Get('columns','height');
         $Xsize=0.0+$Xsize;
         $Ysize=0.0+$Ysize;
         }

It would be easy to re-write the code for any size limit.

Steve 6809er Bjork

At 07:39 AM 7/21/2006 -0700, you wrote:
>Here's a little perl script I cooked up -- it's pretty raw and doesn't  do 
>any error checking, etc.  It's only been tested on a single  computer 
>runing RedHat Linux 8.  No warranty, no responsibility,  bla, bla, bla.
>
>   The purpose is to take multiple .jpg files of arbitrary 
> dimensions,  scale them en masse so that they fit inside a 320 x 200 CoCo 
> screen,  and convert them to 8-bit BMP files that can be displayed by 
> John  Kowalski's HiColor program.
>
>   You need to have the NETPBM utils installed.  I have used 
> djpeg  instead of jpegtopnm -- I don't really exactly remember why, but 
> for  some reason it worked better for me.  djpeg probably comes from  the 
> JPEG library, but the jpegtopnm  utility from NETPBM can  probably be 
> substituted though I think the syntax would need to be  changed.
>
>   Though I haven't tested this, I would think it could be made to 
> work  under MS-Windows in Cygwin.  And, the NETPBM tools have 
> been  ported to OS9-68K.  I have on floppy a binary of Perl 4 
> that  somebody from the EFFO (I think) compiled for 68k and emailed to 
> me  around 1995 or 1996.  He suggested that source would be 
> available  sometime, but I never saw it.  I haven't studied Perl's 
> Artistic  Licence enough to know whether it is proper to distribute this 
> binary  without source, but if anyone wants a copy I'd be happy to 
> share.   I haven't tried cocovert.pl on the MM/1, but it's simple enough 
> it  should be adaptable.  And it could easily be rewritten as a 
> shell  script or maybe in OddJob.
>
>   Anybody who would like to modify this for whatever purpose 
> is  welcome.  I would be inclined to GPL it, though I don't feel 
> the  urge to tack a copy of the license onto this email if nobody 
> is  especially interested in it.  Maybe that should be done if it 
> gets  archived and posted on rtsi.com.
>
>   Code follows:
>
>   cocovert.pl
> 
>----------------------------------------------------------------------------------------------------------------------
>   #!/usr/bin/perl
>   # cocovert.pl Scale and convert JPEG images for use with Sockmaster's 
> HiColor
>   # viewer on the Tandy CoCo3.  Joel Ewy 2005
>
>   @filelist = @ARGV;
>
>   if (!(-s "blackmatte.ppm")) {
>    system ("ppmmake black 320 200 >blackmatte.ppm");
>   }
>
>   for ($i = 0; $i < (@ARGV); $i++) {
>    $filelist[$i] =~ s/jpg/bmp/i;
>    system ("djpeg $ARGV[$i] | pnmscale -xysize 320 200 >$filelist[$i].ppm");
>    system ("pnmcomp -align=center -valign=middle $filelist[$i].ppm 
> blackmatte.ppm >$filelist[$i]1.ppm");
>    system ("ppmquantneural <$filelist[$i]1.ppm 256 >map.ppm");
>    system ("pnmremap -mapfile=map.ppm 
> <$filelist[i]1.ppm >$filelist[$i].ppm");
>    system ("ppmtobmp -bpp=8 <$filelist[$i].ppm >$filelist[$i]");
>    # system ("rm $filelist[$i]*.ppm");
>   }
> 
>----------------------------------------------------------------------------------------------------------------------
>
>
>
>--
>Coco mailing list
>Coco at maltedmedia.com
>http://five.pairlist.net/mailman/listinfo/coco
>
>
>--
>No virus found in this incoming message.
>Checked by AVG Free Edition.
>Version: 7.1.394 / Virus Database: 268.10.3/394 - Release Date: 7/20/2006