/*
 * Tcl command to write the image from a photo widget out to a PPM file.
 *
 * writeppm file photo ?comments?...
 *
 * Copyright 1993 The Australian National University.
 *
 * Permission to use, copy, modify, and distribute this software and its
 * documentation is hereby granted, provided that the above copyright
 * notice appears in all copies.  This software is provided without any
 * warranty, express or implied. The Australian National University
 * makes no representations about the suitability of this software for
 * any purpose.
 *
 * Author: Paul Mackerras (paulus@cs.anu.edu.au)
 *
 * $Header: /home/paulus/CaVis/othersrc/tk3.3/RCS/writeppm.c,v 1.3 1993/10/20 05:40:24 paulus Exp $
 */
#include <stdio.h>
#include <tcl.h>
#include "tkPhoto.h"

int
WritePPMCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    unsigned char *pic, *pp;
    int r, g, b, n, x, y;
    PhotoHandle photo;
    FILE *picfp;
    PhotoImage block;

    if( argc < 3 ){
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
			 " file photo ?comments?...\"",
			 (char *) NULL);
	return TCL_ERROR;
    }

    if( (photo = FindPhoto(argv[2])) == NULL ){
	Tcl_AppendResult(interp, "unknown photo window \"", argv[2], "\"",
			 (char *) NULL);
	return TCL_ERROR;
    }
    if( !PhotoGetImage(photo, &block) ){
	Tcl_AppendResult(interp, "image data not available from photo \"",
			 argv[2], "\"", (char *) NULL);
	return TCL_ERROR;
    }

    if( (picfp = fopen(argv[1], "wb")) == NULL ){
	Tcl_AppendResult(interp, argv[1], Tcl_PosixError(interp),
			 (char *) NULL);
	return TCL_ERROR;
    }

    fprintf(picfp, "P6\n");
    for( n = 3; n < argc; ++n )
	fprintf(picfp, "# %s\n", argv[n]);
    fprintf(picfp, "%d %d\n255\n", block.width, block.height);

    pic = block.ptr;
    if( block.comp_off[0] == 0 && block.comp_off[1] == 1
       && block.comp_off[2] == 2 ){
	if( block.pixel_size == 3 ){
	    b = block.width * 3;
	    if( block.pitch == b ){
		b *= block.height;
		n = fwrite(pic, 1, b, picfp);
	    } else {
		for( y = 0; y < block.height; ++y ){
		    if( (n = fwrite(pic, 1, b, picfp)) != b ){
			n = -1;
			break;
		    }
		    pic += block.pitch;
		}
	    }
	} else {
	    for( y = 0; y < block.height; ++y ){
		pp = pic;
		for( x = 0; x < block.width; ++x ){
		    if( (n = fwrite(pp, 1, 3, picfp)) != 3 ){
			n = -1;
			break;
		    }
		    pp += block.pixel_size;
		}
		pic += block.pitch;
	    }
	}
    } else {
	r = block.comp_off[0];
	g = block.comp_off[1];
	b = block.comp_off[2];
	n = 1;
	for( y = 0; y < block.height; ++y ){
	    pp = pic;
	    for( x = 0; x < block.width; ++x ){
		if( putc(pp[r], picfp) == EOF || putc(pp[g], picfp) == EOF
		   || putc(pp[b], picfp) == EOF ){
		    n = -1;
		    break;
		}
		pp += block.pixel_size;
	    }
	    pic += block.pitch;
	}
    }
    fclose(picfp);

    if( n < 0 ){
	Tcl_AppendResult(interp, "write error on ", argv[1], (char *) NULL);
	return TCL_ERROR;
    }

    return TCL_OK;
}
