Newsgroups: comp.lang.tcl
Subject: tcl_curses.c New Version
From: gnat@kauri.vuw.ac.nz (Nathan Torkington)
Date: Thu, 20 Aug 1992 06:29:42 GMT
Distribution: comp
Organization: Contract to CSC, Victoria Uni, Wellington, New Zealand

Here is both the README and the C source for tcl_curses.c, as
originally written by Poul-Henning Kamp, phk@data.fls.dk, and
subsequently hacked at by Nathan Torkington, gnat@kauri.vuw.ac.nz.

This is a way-cool idea, and if anyone wants to hack at it then
I'd love to have more useful things added (a smarter getstr, etc).
I'm planning on using it a lot in the future.  My comments in the
readme are marked with a [N2].

--begin README
Tcl_curses -- version 0.01 -- 19mar92 -- phk@data.fls.dk
              version 0.02 -- 20Aug92 -- gnat@kauri.vuw.ac.nz [N2]
=============================================================


Introduction:
-------------
I needed a curses interface, so I made one, it's not so hard after all,
but on the other hand it's not yet complete, most of the input it still 
missing.

Some of the functions in curses has no reason to live in a Tcl interface, 
printw() for instance, and scanw() would be a hell to implement too, so
they will probably be better off if made using Tcl format &c &c.

Having added getstr, I find some problems.  Determination of string
length is a problem.  Currently you must give a maximum length of the
string, beforehand.  No enforcement of this is done, however. [N2]

How to use:
-----------

call the 'C' function curses_init(interp) to initialize the curses interface.

This will define a Tcl function named 'curses' and a variable called
'curses_debug'.

Setting a non-zero value in curses_debug will send debugging output to stderr.

The curses function is for general operations, things like initscr, endwin
and newwin.

Each window created (including stdscr by initscr) creates a function named
after that window, which is used for all operations on that window

Example Tcl code:
-----------------

	# initialize the curses(3) package, create stdscr function
	curses initscr
	curses mode noecho cbreak

	# move to line #1, pos#1, and addstr() a silly text
	stdscr -m 0 0 -a so addstr "Outstanding attempt to print text !"

	# move to line #3, pos#2, and addstr() a silly text in bold
	stdscr -m 2 1 -a bold addstr "Bold attempt to print text !"

	# move to line #4, pos#30, and addstr() a silly text in reverse
	stdscr -m 3 29 -a rev addstr "Reverse attempt to print text !"

	# reset the attributes
	stdscr -a ""

	# update the screen
	stdscr refresh

	curses newwin zap 5 8 10 20

	zap -m 0 0 addstr "Any key"
	zap -m 1 0 addstr "Pressed"
	zap -m 2 0 addstr "will be"
	zap -m 3 0 addstr "here->"
	zap -m 4 0 addstr "q exits"

	set ch " "
	while {$ch!="q"} {
	    zap -m 3 6 refresh
	    set ch [zap getch]
	    zap -m 3 6 addstr "$ch"
	    }

	# goodbye
	curses endwin


Extent of implementation:
-------------------------
        curses initscr
        curses endwin
        curses mode [[no]cbreak] [[no]echo] [[no]raw] [[no]nl]
	curses info
        curses newwin <win> <nlin> <ncol> <begin_y> <begin_x>
        <win> [-m <lin> <pos>]
        <win> [-a <{|so|ul|rev|blink|dim|bold}*> ]
        <win> addstr <string>
	<win> getstr <maxstrlen>
        <win> clrtoeol
        <win> clrtobot
        <win> refresh
        <win> erase
        <win> clear
        <win> getch
	<win> box [on | off]


Reference:
----------
        curses initscr
Must be called before any further calls.
        curses endwin
Should be called to reset the terminal mode at the very end of the
program.
        curses mode [[no]cbreak] [[no]echo] [[no]raw] [[no]nl]
Set the terminal mode options.  All options are binary, so noraw is
the opposite of raw.
	curses info
Returns a string consisting of the current terminal mode options.  This
string can later be fed to "curses mode" to reset the terminal mode.
        curses newwin <win> <nlin> <ncol> <begin_y> <begin_x>
Create a new win, <nlin>x<ncol> with top-left at <begin_x>,<begin_y>.
        <win> [-m <lin> <pos>]
Move.  Can be used inside other commands (eg "win -m 3 5 addstr foo").
        <win> [-a <{|so|ul|rev|blink|dim|bold}*> ]
Change attributes of text to be displayed.
        <win> addstr <string>
Write <string> to current position.
	<win> getstr <maxstrlen>
Return a string of up to <maxstrlen> characters, obtained from the user
at current cursor position, in <win>.
        <win> clrtoeol
Clear end of current line.
        <win> clrtobot
Clear to end of <win>.
        <win> refresh
Redraw <win>.  You must call this to make the changes to windows visible.
        <win> erase
Copy blanks to every position in <win>.
        <win> clear
erase *and* redraw from scratch next time refresh is called.
        <win> getch
Return a character obtained from the user in <win>.
	<win> box [on | off]
Turn a border box for <win> on or off.  New windows have no border.
Adding a border moves everything down and to the right by one character,
and draws a border around the window.  Turning the border off moves the
text up and to the left by one character.

Platforms:
----------
I'm on a IBM RS6000/520 with AIX 3.1.7, should work on most machines,
I'm on a SGI Iris 4D and had no problems.  [N2]

I know that BSD curses and SYSV curses are somewhat different, do we need
ifdefs ?

Attribute stuff won't work with BSD curses, so probably #ifdefs will be
needed.  But I won't use BSD curses at all, so I won't write them :-) [N2]

Future:
-------
Send bugs, patches, bug-fixes and suggestions to the keeper of the
relevant section of the code.

gnat@kauri.vuw.ac.nz worked on:
	getstr
	mode
	info
	box

phk@data.fls.dk worked on:
	the rest

--
phk@data.fls.dk		  || Welcome to the '92 Open European Hell:
Poul-Henning Kamp	  ||   A british cook, a german lover, an italian
FLS DATA A/S		  ||   cop, a french bank, a belgian chauffeur,
Phone: (+45) 36 18 12 35  ||   a spanish engineer, a greek manager... &c &c
Fax:   (+45) 36 18 12 18  ||   -- and a danish victim.    (Poul-Henning Kamp)
--end README

--begin tcl_curses.c
/* curses.c
 * CURSES interface for TcL
 * 
 * Poul-Henning Kamp, phk@data.fls.dk
 * 920318 0.00
 * 920319 0.01
 * 920819 0.02 -- NJT
 */

#include <curses.h>
#include <tcl.h>
#include <tclHash.h>

static char *TraceDebug();
static int CursesProc();
static int WinProc();

typedef struct
    {
    int		debug;
    int
      nl,
      cbreak,
      raw,
      echo;
    WINDOW	*stdscr;
    } t_cldat;

typedef struct
    {
    t_cldat	*cd;
    int         wbox;
    WINDOW	*win;
    WINDOW      *border;
    } t_cldat2;

/****************************************************************************
 *
 * curses_init(interp)
 * ===================
 * 
 * Initialize the curses interface.
 *
 ****************************************************************************/

void
curses_init(interp)
    Tcl_Interp	*interp;
    {
    t_cldat *cd;

    cd = (t_cldat *)ckalloc(sizeof *cd);
    memset((void*)cd,0,sizeof *cd);
    Tcl_CreateCommand(interp,"curses",CursesProc,cd,0);
    Tcl_SetVar(interp,"curses_debug","0",0);
    Tcl_TraceVar(interp,"curses_debug",
	TCL_TRACE_WRITES|TCL_TRACE_UNSETS,TraceDebug,cd);
    }

static int
Error(interp,win,where)
    Tcl_Interp  *interp;
    char *win;
    char *where;
    {
    Tcl_AddErrorInfo(interp,"curses ");
    Tcl_AddErrorInfo(interp,win);
    Tcl_AddErrorInfo(interp," ");
    Tcl_AddErrorInfo(interp,where);
    Tcl_AddErrorInfo(interp,": failed");
    return TCL_ERROR;
    }

static char*
TraceDebug(cd,interp,name1,name2,flags)
    t_cldat *cd;
    Tcl_Interp	*interp;
    char *name1;
    char *name2;
    int flags;
    {
    cd->debug=0;
    if(flags & TCL_TRACE_WRITES) 
	cd->debug = 
	    atoi(Tcl_GetVar(interp,"curses_debug",flags&TCL_GLOBAL_ONLY));
    if(flags & TCL_TRACE_UNSETS) 
	Tcl_SetVar(interp,"curses_debug","0",flags&TCL_GLOBAL_ONLY);
    if(flags & TCL_TRACE_DESTROYED)
	Tcl_TraceVar(interp,"curses_debug",
	    TCL_TRACE_WRITES|TCL_TRACE_UNSETS,TraceDebug,cd);
    fprintf(stderr,"CURSES: debug is now %d\n",cd->debug);
    return 0;
    }
    
static int
CursesProc(cd,interp,argc,argv)
    t_cldat *cd;
    Tcl_Interp  *interp;
    int argc;
    char **argv;
    {
    int i;
    Tcl_HashEntry *he;
    t_cldat2 *cd2;

    if(cd->debug)
	{
	fprintf(stderr,"CURSES: CursesProc %d ",argc);
	for(i=0;i<argc;i++)
	    fprintf(stderr,"{%s} ",argv[i]);
	fprintf(stderr,"\n");
	}

    if(!cd->stdscr) 	/* Not yet initscr */
	{
/*XX curses initscr */
	if(argc == 2 && !strcmp(argv[1],"initscr"))
	    {
	      WINDOW *w;
	      w = initscr();
	      if (!w)
		return Error(interp,"<none>",argv[1]);
	      cd2 = (t_cldat2 *)ckalloc(sizeof *cd2);
	      memset((void*)cd2,0,sizeof *cd2);
	      cd2->cd=cd;
	      cd2->win=w;
	      cd2->border=NULL;
	      cd2->wbox=0;
	      cd->stdscr = cd2->win;
	      cd->nl=1;
	      cd->cbreak=0;
	      cd->echo=1;
	      cd->raw=1;
	      Tcl_CreateCommand(interp,"stdscr",WinProc,cd2,0);
	      return TCL_OK;
	    }
	else
	    {
	    Tcl_AddErrorInfo(interp,"curses ");
	    Tcl_AddErrorInfo(interp,argv[1]);
	    Tcl_AddErrorInfo(interp,": must start by calling initscr");
	    return TCL_ERROR;
	    }
	}
    if(argc == 2 && *argv[1]== 'e' && !strcmp(argv[1],"endwin"))
/*XX curses endwin */
	{
	if(endwin() == OK) return TCL_OK;
	return Error(interp,"<none>",argv[1]);
	}
 

    if(argc > 2 && *argv[1]== 'm' && !strcmp(argv[1],"mode")) {
/*XX curses mode <[no]cbreak> <[no]nl> <[no]echo> <[no]raw> */
      argc --; argv ++;
      while (argc > 1) {
	if(*argv[1]== 'c' && !strcmp(argv[1],"cbreak"))
	  {
	    if (cd->cbreak || cbreak() == OK)
	      cd->cbreak = 1;
	    else
	      return Error(interp,"<none>",argv[1]);
	}
	else
	if(*argv[1]== 'n' && !strcmp(argv[1],"nocbreak"))
	{
	  if (!cd->cbreak || nocbreak() == OK)
	    cd->cbreak = 0;
	  else
	    return Error(interp,"<none>",argv[1]);
	}
	else
	if(*argv[1]== 'e' && !strcmp(argv[1],"echo"))
	  {
	    if (cd->echo || echo() == OK)
	      cd->echo=1;
	    else
	      return Error(interp,"<none>",argv[1]);
	  }
	else
	if(*argv[1]== 'n' && !strcmp(argv[1],"noecho"))
	{
	  if (!cd->echo || noecho() == OK)
	    cd->echo=0;
	  else
	    return Error(interp,"<none>",argv[1]);
	}
	else
	if(*argv[1]== 'r' && !strcmp(argv[1],"raw"))
	  {
	    if (cd->raw || raw() == OK)
	      cd->raw=1;
	    else
	      return Error(interp,"<none>",argv[1]);
	  }
	else
	if(*argv[1]== 'n' && !strcmp(argv[1],"noraw"))
	  {
	    if (!cd->raw || noraw() == OK)
	      cd->raw=0;
	    else
	      return Error(interp,"<none>",argv[1]);
	  }
	else
	if(*argv[1]== 'n' && !strcmp(argv[1],"nl"))
	  {
	    if (cd->nl || nl() == OK)
	      cd->nl=1;
	    else
	      return Error(interp,"<none>",argv[1]);
	  }
	else
	if(*argv[1]== 'n' && !strcmp(argv[1],"nonl"))
	  {
	    if (!cd->nl || nonl() == OK)
	      cd->nl=0;
	    else
	      return Error(interp,"<none>",argv[1]);
	  }
	else {
fprintf(stderr, "%s %d\n", argv[1], argc);
	  Tcl_AddErrorInfo(interp, "curses ");
	  Tcl_AddErrorInfo(interp, argv[1]);
	  Tcl_AddErrorInfo(interp, ": Huh ?");
	  return TCL_ERROR;
	}
	
	argv += 1; argc -= 1;
      }
      if (argc < 2)
	return TCL_OK;
    }

    if(argc == 2 && *argv[1]== 'i' && !strcmp(argv[1],"info"))
      /*XX curses info */
      { 
	char buf[30];
	sprintf(buf,"%s%s %s%s %s%s %s%s",  (cd->cbreak)?"":"no", "cbreak",
		(cd->raw)?"":"no", "raw",
		(cd->nl)?"":"no", "nl",
		(cd->echo)?"":"no", "echo");
	Tcl_SetResult(interp,buf,TCL_STATIC); 
	return TCL_OK;
      }
    
    if(argc == 7 && *argv[1]== 'n' && !strcmp(argv[1],"newwin"))
      /*XX curses newwin <win> <nlin> <ncol> <begin_y> <begin_x> */
      {
	WINDOW *w;
	w = newwin(atoi(argv[3]),atoi(argv[4]),atoi(argv[5]),atoi(argv[6]));
	if (!w)
	  return Error(interp, argv[1], argv[2]);
	cd2 = (t_cldat2 *)ckalloc(sizeof *cd2);
	memset((void*)cd2,0,sizeof *cd2);
	cd2->cd=cd;
	cd2->border=NULL;
	cd2->win=w;
	cd2->wbox=0; /* by default, no border */
	Tcl_CreateCommand(interp,argv[2],WinProc,cd2,0);
	return TCL_OK;
	}

    Tcl_AddErrorInfo(interp,"curses ");
    Tcl_AddErrorInfo(interp,argv[1]);
    Tcl_AddErrorInfo(interp,": Huh ?");
    return TCL_ERROR;
    }

static int
WinProc(cd2,interp,argc,argv)
    t_cldat2 *cd2;
    Tcl_Interp  *interp;
    int argc;
    char **argv;
    {
    int i;
    Tcl_HashEntry *he;
    char *win = *argv;

    if(cd2->cd->debug)
	{
	fprintf(stderr,"CURSES: WinProc %d ",argc);
	for(i=0;i<argc;i++)
	    fprintf(stderr,"{%s} ",argv[i]);
	fprintf(stderr,"\n");
	}
    if(argc < 2)
	{
	Tcl_AddErrorInfo(interp,"curses ");
	Tcl_AddErrorInfo(interp,win);
	Tcl_AddErrorInfo(interp,": no args");
	return TCL_ERROR;
	}

    while(argc > 1 && *argv[1] == '-')
	{
	if(argc >= 4 && !strcmp(argv[1],"-m"))
/*XX <win> [-m <lin> <pos>] */
	    {
	    if(OK != wmove(cd2->win,atoi(argv[2]),atoi(argv[3])))
		Error(interp,win,argv[1]);
	    argv += 3; argc -= 3;
	    }
	else if(argc >= 3 && !strcmp(argv[1],"-a"))
/*XX <win> [-a <{|so|ul|rev|blink|dim|bold}*> ] */
	    {
	    char *s,*t;

	    i=0;
	    for(t=argv[2];t && *t;t=s)
		{
		for(s=t;*s && !isspace(*s);s++)
		    ;
		if(!*s)
		    s=0;
		else
		    *s++ = '\0';
		if(!strcmp(t,"so")) i |= A_STANDOUT;
		else if(!strcmp(t,"ul")) i |= A_UNDERLINE;
		else if(!strcmp(t,"rev")) i |= A_REVERSE;
		else if(!strcmp(t,"blink")) i |= A_BLINK;
		else if(!strcmp(t,"dim")) i |= A_DIM;
		else if(!strcmp(t,"bold")) i |= A_BOLD;
		else
		    {
		    Tcl_AddErrorInfo(interp,"curses ");
		    Tcl_AddErrorInfo(interp,win);
		    Tcl_AddErrorInfo(interp," ");
		    Tcl_AddErrorInfo(interp,argv[1]);
		    Tcl_AddErrorInfo(interp," ");
		    Tcl_AddErrorInfo(interp,t);
		    Tcl_AddErrorInfo(interp,": Huh ?");
		    return TCL_ERROR;
		    }
		}
	    wattrset(cd2->win,i);
	    argv += 2; argc -= 2;
	    }
	else
	    {
	    Tcl_AddErrorInfo(interp,"curses ");
	    Tcl_AddErrorInfo(interp,win);
	    Tcl_AddErrorInfo(interp," ");
	    Tcl_AddErrorInfo(interp,argv[1]);
	    Tcl_AddErrorInfo(interp,": Huh ?");
	    return TCL_ERROR;
	    }
	}
    if(argc == 1)
	return TCL_OK;
    if(argc == 3 && *argv[1]== 'b' && !strcmp(argv[1],"box"))
/*XX box [on | off]*/
      {
	if(!strcmp(argv[2], "on")) {
	  if (cd2->wbox)
	    /* already on! */
	    return Error(interp, win, argv[1]);
	  /* not on, so make make border on */
	  cd2->wbox = 1;
	  cd2->border = cd2->win;
	  cd2->win=newwin(cd2->border->_maxy - cd2->border->_begy - 2,
			  cd2->border->_maxx - cd2->border->_begx - 2,
			  cd2->border->_begy + 1, cd2->border->_begx + 1);
	  if (!cd2->win) {
	    cd2->wbox = 0;
	    cd2->win = cd2->border;
	    cd2->border = NULL;
	    return Error(interp, win, argv[1]);
	  }
	  copywin(cd2->border,cd2->win,1,1,0,0,
		  cd2->win->_maxy, cd2->win->_maxx, TRUE);
	  box(cd2->border,0,0);
	}
	if(!strcmp(argv[2], "off")) {
	  if (!cd2->wbox)
	    return Error(interp, win, argv[1]);
	  /* box can be turned off */
	  cd2->wbox = 0;
	  werase(cd2->border);
	  copywin(cd2->win,cd2->border,0,0,1,1,
		  cd2->win->_maxy-1, cd2->win->_maxx-1, TRUE);
	  delwin(cd2->win);
	  cd2->win = cd2->border;
	  cd2->border = NULL;
	}
	return TCL_OK;
      }
    if(argc == 3 && *argv[1] == 'a' && !strcmp(argv[1],"addstr"))
/*XX <win> addstr <string> */
	{
	if(OK == waddstr(cd2->win,argv[2]))
	    return TCL_OK;
	return Error(interp,win,argv[1]);
	}
    if(argc == 2 && *argv[1] == 'c' && !strcmp(argv[1],"clrtoeol"))
/*XX <win> clrtoeol */
	{ wclrtoeol(cd2->win); return TCL_OK; }
    if(argc == 2 && *argv[1] == 'c' && !strcmp(argv[1],"clrtobot"))
/*XX <win> clrtobot */
	{ wclrtobot(cd2->win); return TCL_OK; }
    if(argc == 2 && *argv[1] == 'r' && !strcmp(argv[1],"refresh"))
/*XX <win> refresh */
        { 
	  if (cd2->wbox) wrefresh(cd2->border); wrefresh(cd2->win); return TCL_OK; }
    if(argc == 2 && *argv[1] == 'e' && !strcmp(argv[1],"erase"))
/*XX <win> erase */
	{ werase(cd2->win); return TCL_OK; }
    if(argc == 2 && *argv[1] == 'c' && !strcmp(argv[1],"clear"))
/*XX <win> clear */
	{ wclear(cd2->win); return TCL_OK; }
    if(argc == 2 && *argv[1] == 'g' && !strcmp(argv[1],"getch"))
/*XX <win> getch */
	{
	char buf[2];
	buf[1]=0;
	buf[0]=wgetch(cd2->win);
	Tcl_SetResult(interp,buf,TCL_STATIC);
	return TCL_OK; 
	}
    if(argc == 3 && *argv[1] == 'g' && !strcmp(argv[1],"getstr"))
/*XX <win> getstr <maxstrsize>*/
      {
	char *buf;
	buf=(char *)malloc(1+atoi(argv[2]));
	if(!buf)
	  return Error(interp,win,argv[1]);
	memset((void*)buf,0,1+atoi(argv[2]));
	if (OK!=wgetstr(cd2->win,buf)) {
	  free(buf);
	  return Error(interp,win,argv[1]);
	}
	Tcl_SetResult(interp,buf,TCL_STATIC);
	free(buf);
	return TCL_OK;
      }

    Tcl_AddErrorInfo(interp,"curses ");
    Tcl_AddErrorInfo(interp,win);
    Tcl_AddErrorInfo(interp,": >>");
    Tcl_AddErrorInfo(interp,argv[1]);
    Tcl_AddErrorInfo(interp,"<< Huh ?");
    return TCL_ERROR;
    }
--end

Cheers;

Nat.
(gnat@kauri.vuw.ac.nz -- Nathan Torkington -- is the electronic text and
 MS-DOS archivist for the Victoria University of Wellington, New Zealand)