/***********************************************************************/
/*                                                                     */
/*                 MLTk, Tcl/Tk interface of OCaml                     */
/*                                                                     */
/*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    */
/*               projet Cristal, INRIA Rocquencourt                    */
/*            Jacques Garrigue, Kyoto University RIMS                  */
/*                                                                     */
/*  Copyright 2002 Institut National de Recherche en Informatique et   */
/*  en Automatique and Kyoto University.  All rights reserved.         */
/*  This file is distributed under the terms of the GNU Library        */
/*  General Public License, with the special exception on linking      */
/*  described in file LICENSE found in the OCaml source tree.          */
/*                                                                     */
/***********************************************************************/
#include <string.h>
#include <tcl.h>
#include <tk.h>
#include <mlvalues.h>
#include <memory.h>
#include <alloc.h>
#include "camltk.h"

/*
 * Pixmap manipulation from OCaml : get the pixmap from an arbitrary photo
 * image, and put it back in some (possibly other) image.
 * TODO: other blits
 * We use the same format of "internal" pixmap data as in Tk, that is
 * 24 bits per pixel
 */

CAMLprim value camltk_getimgdata (value imgname) /* ML */
{
  CAMLparam1(imgname);
  CAMLlocal1(res);
  Tk_PhotoHandle ph;
  Tk_PhotoImageBlock pib;
  int code,size;

#if (TK_MAJOR_VERSION < 8)
  if (NULL == (ph = Tk_FindPhoto(String_val(imgname))))
    tk_error("no such image");
#else
  if (NULL == (ph = Tk_FindPhoto(cltclinterp, String_val(imgname))))
    tk_error("no such image");
#endif

  code = Tk_PhotoGetImage(ph,&pib); /* never fails ? */
  (void) code;
  size = pib.width * pib.height * pib.pixelSize;
  res = caml_alloc_string(size);

  /* no holes, default format ? */
  if ((pib.pixelSize == 3) &&
      (pib.pitch == (pib.width * pib.pixelSize)) &&
      (pib.offset[0] == 0) &&
      (pib.offset[1] == 1) &&
      (pib.offset[2] == 2)) {
    memcpy(pib.pixelPtr, String_val(res),size);
    CAMLreturn(res);
  } else {
    int y;                      /* varies from 0 to height - 1 */
    int yoffs = 0;              /* byte offset of line in src */
    int yidx = 0;               /* byte offset of line in dst */
    for (y=0; y<pib.height; y++,yoffs+=pib.pitch,yidx+=pib.width * 3) {
      int x;                    /* varies from 0 to width - 1 */
      int xoffs = yoffs;        /* byte offset of pxl in src */
      int xidx = yidx;          /* byte offset of pxl in dst */
      for (x=0; x<pib.width; x++,xoffs+=pib.pixelSize,xidx+=3) {
        Byte(res, xidx) = pib.pixelPtr[xoffs+pib.offset[0]];
        Byte(res, xidx + 1) = pib.pixelPtr[xoffs+pib.offset[1]];
        Byte(res, xidx + 2) = pib.pixelPtr[xoffs+pib.offset[2]];
      };
    }
    CAMLreturn(res);
  }
}

CAMLprim value
camltk_setimgdata_native (value imgname, value pixmap, value x, value y,
                   value w, value h) /* ML */
{
  Tk_PhotoHandle ph;
  Tk_PhotoImageBlock pib;

#if (TK_MAJOR_VERSION < 8)
  if (NULL == (ph = Tk_FindPhoto(String_val(imgname))))
    tk_error("no such image");
#else
  if (NULL == (ph = Tk_FindPhoto(cltclinterp, String_val(imgname))))
    tk_error("no such image");
#endif

  pib.pixelPtr = (unsigned char *)String_val(pixmap);
  pib.width = Int_val(w);
  pib.height = Int_val(h);
  pib.pitch = pib.width * 3;
  pib.pixelSize = 3;
  pib.offset[0] = 0;
  pib.offset[1] = 1;
  pib.offset[2] = 2;
  Tk_PhotoPutBlock(
#if (TK_MAJOR_VERSION == 8 && TK_MINOR_VERSION >= 5 || TK_MAJOR_VERSION > 8)
        NULL,
#endif
ph,&pib,Int_val(x),Int_val(y),Int_val(w),Int_val(h)
#if (TK_MAJOR_VERSION == 8 && TK_MINOR_VERSION >= 4 || TK_MAJOR_VERSION > 8)
                   , TK_PHOTO_COMPOSITE_SET
#endif
    );
  return Val_int(0);
}

CAMLprim value camltk_setimgdata_bytecode(argv,argn)
     value *argv;
     int argn;
{
  return camltk_setimgdata_native(argv[0], argv[1], argv[2], argv[3],
                                  argv[4], argv[5]);
}