#include <stdio.h>
#include "mktclapp.h"
#include <sys/ioctl.h>
#include <linux/kd.h>
#include <errno.h>
#include <string.h>
#include <ctype.h>

/* for setkbdrepeat: */
#include <sys/types.h>
#include <sys/stat.h>
#include <unistd.h>
#include <fcntl.h>

/* Where's the standard definition for this? */
#define min(a,b) ((a) < (b) ? (a) : (b))

/*
 * «.defines»	      (to "defines")
 * «.change_char»	(to "change_char")
 * «.change_nchars»	(to "change_nchars")
 * «.change_nrows»	(to "change_nrows")
 * «.duplicate_rows»	(to "duplicate_rows")
 * «.setfont»		(to "setfont")
 * «.tobinary»		(to "tobinary")
 * «.toasciirow»	(to "toasciirow")
 * «.vcsa2pnmdata»	(to "vcsa2pnmdata")
 * «.setkbdrepeat»	(to "setkbdrepeat")
 *
 * We are defining the following new Tcl commands:
 * change_char nchar chardata nchars nrows data  ->  newdata
 * change_nchars    newnchars nchars nrows data  ->  newdata
 * change_nrows      newnrows nchars nrows data  ->  newdata
 * duplicate_rows        data                    ->  newdata
 * setfont            channel nchars nrows data
 * toasciirow            byte c0 c1 width        ->  chardata
 * tobinary           rowdata rowdata ...        ->  chardata
 * vcsa2pnmdata rgb0 rgb1 ... rgb15 nchars nrows fontdata vcsadata
 * setkbdrepeat         value
 *
 *
 * (find-es "emacs" "key_bindings")
 * (define-key c-mode-base-map "\ee" nil)
 * (find-es "mktclapp")
 * (eeman "mktclapp")
 * (find-w3 "/usr/doc/mktclapp/mktclapp.html")
 *
 * (find-node "(libc)Function Index")
 * (find-vldifile "tcl8.0-dev.list")
 * (find-vldifile "tcl8.2-dev.list")
 * (find-vldifile "tcl8.3-dev.list")
 * (find-vldifile "tcl8.0-doc.list")
 * (find-vldifile "tcl8.2-doc.list")
 * (find-vldifile "tcl8.3-doc.list")
 * (eeman "Tcl_GetLongFromObj")
 * (eeman "Tcl_GetStringFromObj")
 * (eeman "Tcl_GetByteArrayFromObj")
 * (eeman "Tcl_GetInt")
 * (find-tcltag "Tcl_CloseObjCmd")
 * (find-tcltag "Tcl_WrongNumArgs")
 * (find-tcltag "Tcl_GetChannel")
 * (find-tcltag "Channel")
 * (eeman "Tcl_GetChannel")
 *
 * (find-angg "MTA/")
 * (eeman "Tcl_SetObjResult")
 * (eeman "Tcl_NewStringObj")
 * (eeman "Tcl_NewByteArrayObj")
 *
 */



/*
 * «defines»  (to ".defines")
 * Some "#define"s to make using MkTclApp easier.
 * Important change: in tcl8.2 and later, strings are unibyte by
 * default, and we need to use the "ByteArray" functions to access the
 * real binary data.
 * I haven't changed NewStringObject to NewByteArrayObject yet.
 * (eeman "3tcl Tcl_GetStringFromObj")
 * (eeman "3tcl Tcl_GetByteArrayFromObj")
 *
 */

#define ET_ERRORF(listargs) ({Et_ResultF listargs; return TCL_ERROR;})
#define ET_ERROR(str) ET_ERRORF((interp,str))
#define ET_ERROR1(str,a) ET_ERRORF((interp,str,a))
#define ET_ERROR2(str,a,b) ET_ERRORF((interp,str,a,b))
#define ET_ERROR3(str,a,b,c) ET_ERRORF((interp,str,a,b,c))
#define ET_ERROR4(str,a,b,c,d) ET_ERRORF((interp,str,a,b,c,d))

/* #define OARGV_STRING(n, lenptr)  Tcl_GetStringFromObj(objv[n], lenptr) */
#define OARGV_STRING(n, lenptr)	Tcl_GetByteArrayFromObj(objv[n], lenptr)

#define OARGV0			OARGV_STRING(0, 0)

#define OARGV_INT(n) ({		\
  int _tmpint;			\
  if (Tcl_GetIntFromObj(interp, objv[n], &_tmpint) != TCL_OK)	\
    ET_ERROR2("%s: arg %d not an int", OARGV0, n);	\
  _tmpint;			\
})



#define ET_OARGSERROR(argstr)	\
  ET_ERROR2("wrong # args: should be \"%s %s\"", OARGV0, argstr)

#define ET_ARGSERROR(argstr)	\
  ET_ERROR2("wrong # args: should be \"%s %s\"", argv[0], argstr)



#define ET_ORETURN(data, len)					\
  Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(data, len))




/*
 * A special #define to get the nchars/nrows/data triples.
 *
 */
#define get_nchars_nrows_data_len(pnchars, pnrows, pdata)	\
({nchars = OARGV_INT(pnchars);					\
  if (nchars != 256 && nchars != 512)				\
    ET_ERROR("NCHARS must be 256 or 512");			\
  nrows = OARGV_INT(pnrows);					\
  if (nrows < 1 || nrows > 32)					\
    ET_ERROR("NROWS must be in the range 1..32");		\
  data = OARGV_STRING(pdata, &len);				\
  if (len != nchars * nrows)					\
    ET_ERROR2("DATA has len %d, should have been %d",		\
		len, nchars * nrows);				\
})




/*
 * «change_char»  (to ".change_char")
 * change_char NCHAR CHARDATA NCHARS NROWS DATA  ->  NEWDATA
 *
 */
int ET_OBJCOMMAND_change_char(ET_OBJARGS) {
  int nchar, charlen, nchars, nrows, len;
  char *chardata, *data, newdata[512 * 32];

  if(objc != 6)
    ET_OARGSERROR("NCHAR CHARDATA NCHARS NROWS DATA");

  nchar = OARGV_INT(1);
  chardata = OARGV_STRING(2, &charlen);
  get_nchars_nrows_data_len(3, 4, 5);

  if (nchar < 0 || nchar >= nchars)
    ET_ERROR("NCHAR must be in the range 0..NCHARS-1");

  if (charlen < 1 || charlen > 32)
    ET_ERROR("The lenght of CHARDATA must be in the range 1..32");

  memcpy(newdata, data, nchars*nrows);
  memset(newdata + nchar*nrows, 0, nrows);
  memcpy(newdata + nchar*nrows, chardata, min(charlen, nrows));
  ET_ORETURN(newdata, nchars * nrows);
  return TCL_OK;
}




/*
 * «change_nchars»  (to ".change_nchars")
 * change_nchars NEWNCHARS NCHARS NROWS DATA  ->  NEWDATA
 *
 */
int ET_OBJCOMMAND_change_nchars(ET_OBJARGS) {
  int newnchars, nchars, nrows, len;
  char *data, newdata[512 * 32];

  if(objc != 5)
    ET_OARGSERROR("NEWNCHARS NCHARS NROWS DATA");

  newnchars = OARGV_INT(1);
  if (newnchars != 256 && newnchars != 512)
    ET_ERROR("NEWNCHARS must be 256 or 512");

  get_nchars_nrows_data_len(2, 3, 4);

  memset(newdata, 0, newnchars * nrows);
  memcpy(newdata, data, min(newnchars, nchars) * nrows);

  ET_ORETURN(newdata, newnchars * nrows);
  return TCL_OK;
}




/*
 * «change_nrows»  (to ".change_nrows")
 * change_nrows NEWNROWS NCHARS NROWS DATA -> NEWDATA
 *
 */
int ET_OBJCOMMAND_change_nrows(ET_OBJARGS) {
  int newnrows, nchars, nrows, len, i;
  char *data, newdata[512 * 32];

  if(objc != 5)
    ET_OARGSERROR("NEWNROWS NCHARS NROWS DATA");

  newnrows = OARGV_INT(1);
  if (newnrows < 1 || newnrows > 32)
    ET_ERROR("NEWNROWS must be in the range 1..32");

  get_nchars_nrows_data_len(2, 3, 4);

  memset(newdata, 0, nchars * newnrows);
  for(i=0; i<nchars; ++i)
    memcpy(newdata + i*newnrows, data + i*nrows, min(newnrows, nrows));

  ET_ORETURN(newdata, nchars * newnrows);
  return TCL_OK;
}



/*
 * «duplicate_rows»  (to ".duplicate_rows")
 * duplicate_rows DATA  ->  NEWDATA
 *
 */
int ET_OBJCOMMAND_duplicate_rows(ET_OBJARGS) {
  int len, i;
  char *data, newdata[512 * 32], *p1, *p2;

  if(objc != 2)
    ET_OARGSERROR("DATA");

  data = OARGV_STRING(1, &len);
  if (len > 512 * 16)
    ET_ERROR("Input data too long (limit 512*16 bytes)");

  for(i=0, p1=data, p2=newdata; i<len; ++i) {
    *p2++ = *p1;
    *p2++ = *p1++;
  }

  ET_ORETURN(newdata, len * 2);
  return TCL_OK;
}




/*
 * «setfont»  (to ".setfont")
 * setfont CHANNEL NCHARS NROWS DATA
 *
 */
int ET_OBJCOMMAND_setfont(ET_OBJARGS) {
  int f, nchars, nrows, len, i;
  char *data, newdata[512 * 32];
  struct consolefontdesc cfd;

  if (objc != 5)
    ET_OARGSERROR("CHANNEL NCHARS NROWS DATA");

  if (sscanf(OARGV_STRING(1, 0), "file%d", &f) != 1)
    ET_ERROR("FILEDESCR must be a file descriptor");

  get_nchars_nrows_data_len(2, 3, 4);

  memset(newdata, 0, 512 * 32);
  for(i=0; i<nchars; ++i)
    memcpy(newdata + i*32, data + i*nrows, nrows);

  cfd.charheight = nrows;
  cfd.charcount = nchars;
  cfd.chardata = newdata;
  if (ioctl(f, PIO_FONTX, &cfd))
    ET_ERROR1("PIO_FONTX error: %s", strerror(errno));

  /* we return nothing. */
  return TCL_OK;
}



/*
 * «tobinary»  (to ".tobinary")
 * tobinary ROWDATA ROWDATA ... -> CHARDATA
 *
 * We only consider the last bit in each char of a ROWDATA.
 * Remember that "0" and " " have even ascii codes, "1" and "o" have
 * odd ascii codes.
 *
 */
int ET_OBJCOMMAND_tobinary(ET_OBJARGS) {
  int n, len, i, byte, bit;
  char *rowdata, chardata[512*32];

  if(objc < 1+1 || objc > 512*32+1)
    ET_OARGSERROR("ROWDATA ... (repeated 1 to 512*32 times)");

  for(n=0; n<objc-1; ++n) {
    rowdata = OARGV_STRING(1+n, &len);
    if (len != 8)
      ET_ERROR3("The %dth parameter (\"%q\") has lenght %d instead of 8",
		n+1, rowdata, len);
    for(byte=0, i=0, bit=128; bit>0; ++i, bit>>=1)
      byte |= rowdata[i]&1?bit:0;
    chardata[n] = byte;
  }

  ET_ORETURN(chardata, n);
  return TCL_OK;
}




/*
 * «toasciirow»  (to ".toasciirow")
 * toasciirow BYTE C0 C1 WIDTH -> CHARDATA
 *
 * We only consider the last bit in each char of a ROWDATA.
 * Remember that "0" and " " have even ascii codes, "1" and "o" have
 * odd ascii codes.
 *
 */
int ET_OBJCOMMAND_toasciirow(ET_OBJARGS) {
  char byte, c0, c1, chardata[10];
  int i, bit, width;

  if(objc != 4+1)
    ET_OARGSERROR("BYTE C0 C1 WIDTH");
  byte = *OARGV_STRING(1, 0);
  c0 = *OARGV_STRING(2, 0);
  c1 = *OARGV_STRING(3, 0);
  width = OARGV_INT(4);
  if (width < 8 || width > 9)
    ET_ERROR("WIDTH must be 8 or 9");

  for(i=0, bit=128; i<8; ++i, bit>>=1)
    chardata[i] = (byte & bit) ? c1 : c0;
  chardata[8] = ((byte&7)==7) ? c1 : c0;
  chardata[width] = 0;
  ET_ORETURN(chardata, width);
  return TCL_OK;
}





/* (+ 2 (* (+ 1 (* 6 8 80)) 8 50)) */
/* (+ 2 (* (+ 1 (* 6 8 132)) 8 50)) */
/* °°ħħÛÛ ²² */
/* (find-fline "~/ICON/vcsa2pnm.icn")
 */

#define ASCS_PER_PIXEL 6
#define PNMBUFFERSIZE ((ASCS_PER_PIXEL*9*132+1)*60*8+2)
#define APPEND(str) (memcpy(p, str, strlen(str)), p+=strlen(str))



/*
 * «vcsa2pnmdata»  (to ".vcsa2pnmdata")
 * vcsa2pnmdata RGB0 RGB1 ... RGB15 NCHARS NROWS FONTDATA VCSADATA
 * Used to make screenshots of text screens.
 * (find-k22file "drivers/char/vc_screen.c" "4 bytes")
 * At this time we just guess it's 80x50.
 *
 */
int ET_OBJCOMMAND_vcsa2pnmdata(ET_OBJARGS) {
  char pnmbuffer[PNMBUFFERSIZE];
  char *p = pnmbuffer;
  unsigned char *vcsabuf;
  char *colors[16], *fgcolor, *bgcolor;
  int i, tmplen, v, pv, h, pbyte, color, pbit;
  int nchars, nrows, len;
  char *data;			/* fontdata */

  if(objc != 21)
    ET_OARGSERROR("RGB0 RGB1 ... RGB15 NCHARS NROWS FONTDATA VCSADATA");

  for(i=0; i<16; ++i) {
    colors[i] = OARGV_STRING(1+i, &tmplen);
    if(tmplen>ASCS_PER_PIXEL)
      ET_ERROR4("color %i ({%s}) has lenght %d; max is %d",
		i, colors[i], tmplen, ASCS_PER_PIXEL);
  }

  get_nchars_nrows_data_len(17, 18, 19);

  vcsabuf = OARGV_STRING(20, 0) + 4; /* skip #lines,#cols,x,y */

  for(v=0; v<50; ++v) {
    for(pv=0; pv<8; ++pv) {
      for(h=0; h<80; ++h) {
	pbyte = data[vcsabuf[v*80*2 + h*2]*nrows + pv];
	color = vcsabuf[v*80*2 + h*2 + 1];
	fgcolor = colors[color&0x0F];
	bgcolor = colors[(color&0xF0)>>4];
	for(pbit=128; pbit!=0; pbit>>=1) {
	  APPEND(pbyte&pbit?fgcolor:bgcolor);
	}
	APPEND((pbyte&0x07)==0x07?fgcolor:bgcolor); /* 9th column */
	APPEND("\n");		/* after every row of a char a newline */
      }
      APPEND("\n");		/* after every row an extra newline */
    }
    APPEND("\n");		/* after every row of chars another newline */
  }
  *p=0;				/* end of string */

  Et_ResultF(interp, "%s", pnmbuffer);
  return TCL_OK;
}




/*
 * «setkbdrepeat»  (to ".setkbdrepeat")
 * setkbdrepeat VALUE
 * This is a quick hack inspired on kbdrate.
 * (code-c-d "ul" "/usr/src/util-linux-2.10f/")
 * (find-ulfile "kbd/kbdrate.c" "\"/dev/port\"")
 * value = ndelay*32 + nrate,
 * where ndelay=0 means 250ms and nrate=0 means 30.0 cps
 * higher ndelays mean wait more, higher nrates mean slower repeats.
 *
 */
int ET_OBJCOMMAND_setkbdrepeat(ET_OBJARGS) {
  int value = 0x7f;		/* Maximum delay with slowest rate */
  int fd;
  char data;
  int ms;
  if(objc != 3)
    ET_OARGSERROR("VALUE MS");
  value = OARGV_INT(1);
  ms = OARGV_INT(2);

  if ( (fd = open( "/dev/port", O_RDWR )) < 0) {
    ET_ERROR("Cannot open /dev/port.  Check the permissions");
  }

  do {
    lseek( fd, 0x64, 0 );
    read( fd, &data, 1 );
  } while ((data & 2) == 2 );  /* wait */

  lseek( fd, 0x60, 0 );
  data = 0xf3;                 /* set typematic rate */
  write( fd, &data, 1 );

  do {
    lseek( fd, 0x64, 0 );
    read( fd, &data, 1 );
  } while ((data & 2) == 2 );  /* wait */

  lseek( fd, 0x60, 0 );
  /*
   * sleep( 1 );
   * (eeman "Tcl_Sleep")
   */
  Tcl_Sleep(ms);
  write( fd, &value, 1 );

  close( fd );
  return TCL_OK;
}



/*
 * Local Variables:
 * coding:               no-conversion
 * ee-anchor-format:     "«%s»"
 * ee-charset-indicator: "Ñ"
 * End:
 */