/* 
 * bin_Misc.c --
 *
 * Copyright (c) 1994 Joseph V. Moss
 *
 * See the file "LICENSE" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tcl.h"
#include "tclInt.h"
#include "binario.h"


/*
 *----------------------------------------------------------------------
 *
 * Bin_Init --
 *
 *	This procedure adds various commands to the specified
 *	interpreter and allocates space for, initializes, and links
 *      to equivalent Tcl variabls the escChar and defBinmode vars
 *	
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */
int	Bin_Init(interp)
Tcl_Interp	*interp;
{
	BinClient *clientstruct;

	clientstruct = (BinClient *) ckalloc(sizeof(BinClient));
	clientstruct->escChar = '~';
	clientstruct->defBinmode = 0;

	Tcl_LinkVar(interp, "bin_EscChar",
		(char *) &clientstruct->escChar, TCL_LINK_INT);
	Tcl_LinkVar(interp, "bin_Mode",
		(char *) &clientstruct->defBinmode, TCL_LINK_BOOLEAN);

	Tcl_CreateCommand(interp, "bin_eof", Bin_EofCmd,
		(ClientData) clientstruct, (void (*)()) NULL);
	Tcl_CreateCommand(interp, "bin_open", Bin_OpenCmd,
		(ClientData) clientstruct, (void (*)()) NULL);
	
	Tcl_CreateCommand(interp, "bin_gets", Bin_GetsCmd,
		(ClientData) clientstruct, (void (*)()) NULL);
	
	Tcl_CreateCommand(interp, "bin_puts", Bin_PutsCmd,
		(ClientData) clientstruct, (void (*)()) NULL);
	
	Tcl_CreateCommand(interp, "bin_read", Bin_ReadCmd,
		(ClientData) clientstruct, (void (*)()) NULL);

	Tcl_CreateCommand(interp, "bin_arr2str", Bin_arr2str,
		(ClientData) clientstruct, (void (*)()) NULL);

	Tcl_CreateCommand(interp, "bin_str2arr", Bin_str2arr,
		(ClientData) clientstruct, (void (*)()) NULL);

	return TCL_OK;
}


#define BUF_SIZE 32
#define	MAX_CHAR 255	/* Maximum char value */

/*
 *----------------------------------------------------------------------
 *
 * Bin_arr2str --
 *
 *	This procedure is invoked to process the "bin_arr2str" command.
 *	Converts a "binary" string to an array of integer values
 *	corresponding to the characters in the string
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */



int	Bin_arr2str(clientData, interp, argc, argv)
ClientData clientData;		/* binary (null) escape char */
Tcl_Interp *interp;		/* ptr to interpreter struct */
int argc;			/* arg count */
char **argv;			/* arg values */
{
	char	indexbuf[BUF_SIZE], valuebuf[BUF_SIZE], *valueptr;
	int	index, value;
	BinClient *BinInfo = (BinClient *) clientData;

	if (argc != 2) {
		Tcl_AppendResult(interp, "wrong # args: should be \"",
			argv[0], " arrayname\"", (char *) NULL);
		return TCL_ERROR;
	}

	Tcl_SetResult(interp, "", TCL_STATIC);

	for ( index = 0; ; index++ ) {
		sprintf(indexbuf, "%d", index);
		if ((valueptr = Tcl_GetVar2(interp, argv[1], indexbuf,
				0)) == NULL) {
			if (index > 0)
				return TCL_OK;
			return TCL_ERROR;
		}
		if (Tcl_GetInt(interp, valueptr, &value) != TCL_OK)
			return TCL_ERROR;
		if ( value > MAX_CHAR || value < 0 ) {
			Tcl_SetResult(interp, "Invalid character value",
				TCL_STATIC);
			return TCL_ERROR;
		}
		if ( value == UCHAR(BinInfo->escChar) )
			sprintf(valuebuf, "%c%c",
				UCHAR(BinInfo->escChar),
				UCHAR(BinInfo->escChar));
		else if ( value == 0 )
			sprintf(valuebuf, "%c%c",
				UCHAR(BinInfo->escChar), '0');
		else
			sprintf(valuebuf, "%c", value);

		Tcl_AppendResult(interp, valuebuf, NULL);
	}

	return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Bin_str2arr --
 *
 *	This procedure is invoked to process the "bin_str2arr" command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int	Bin_str2arr(clientData, interp, argc, argv)
ClientData clientData;		/* binary (null) escape char */
Tcl_Interp *interp;		/* ptr to interpreter struct */
int argc;			/* arg count */
char **argv;			/* arg values */
{
	int	index, value;
	BinClient *BinInfo = (BinClient *) clientData;
	char	indexbuf[BUF_SIZE], valuebuf[BUF_SIZE];
	unsigned char	*p;

	if (argc != 3) {
		Tcl_AppendResult(interp, "wrong # args: should be \"",
			argv[0], " string arrayname\"", (char *) NULL);
		return TCL_ERROR;
	}
	Tcl_UnsetVar(interp, argv[2], 0);
	index = 0;
	for (p= (unsigned char *) argv[1]; *p != '\0'; index++, p++) {
		if ( *p == UCHAR(BinInfo->escChar) && *++p == UCHAR('0') )
			value = 0;
		else
			value = *p;

		sprintf(indexbuf, "%d", index);
		sprintf(valuebuf, "%d", value);
		if (Tcl_SetVar2(interp, argv[2], indexbuf,
				valuebuf, TCL_LEAVE_ERR_MSG) == NULL)
			return TCL_ERROR;
	}
	return TCL_OK;
}
