Version 12 of Minimalist Curses

Updated 2004-11-08 12:01:03 by lwv

2004-02-11 VI

I looked around for a curses package, so I could make my sysadmin scripts be more friendly. Here's a minimalist approach. A package which allows access to the bare bones. I think this should be enough to build any text UI, with everything else in Tcl. See revision history at the end.


 /* curses.c
    A "minimalist" tcl package for interfacing to curses.  Goes into
    curses mode on load and automatically comes out at exit
    Venkat Iyer.  VI.  [email protected]

    Usage:

    curses init (no need to call, automatically done at load)
    curses end  (no need to call, automatically done at exit)
    curses attr <on/off> <standout/underline/reverse/blink/dim/bold/alt>
    curses move <row> <column> : move to screen position, 0 0 is top left
    curses puts  : print a string
    curses info  <rows/cols> : return the number of rows/cols in screen
    curses erase : clear the screen
    curses refresh : actually do refresh to physical screen

    Build: 
    gcc -I/usr/local/tcl/8.4.5/include -fPIC -c curses.c -o curses.o

    (something like this, which is on solaris7):
    ld -r curses.o -o curses.so -Bsymbolic /usr/lib/libcurses.a
    (on linux)
    gcc -shared curses.o -o curses.so /usr/lib/libcurses.a
 */

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

 /*
  * Forward declarations for procedures defined later in this file:
  */

 static int cursesCmd _ANSI_ARGS_ ((ClientData dummy,
                                Tcl_Interp *interp, int objc, 
                                Tcl_Obj *CONST objv[]));

 static int curses_start (void);
 static void curses_exit  (ClientData dummy); /* exit handler */

 /*
  *----------------------------------------------------------------------
  *
  * Curses_Init --
  *
  *     This procedure is the main initialisation point of the Curses
  *     extension.
  *
  * Results:
  *     Returns a standard Tcl completion code, and leaves an error
  *     message in the interp's result if an error occurs.  We're OK
  *      to init in a safe interpreter.  No file access done.
  *
  * Side effects:
  *     Adds a command to the Tcl interpreter.  Adds an exit handler
  *      and changes the screen into raw mode
  *
  *----------------------------------------------------------------------
  */


 int
 Curses_Init (interp)
     Tcl_Interp *interp;                /* Interpreter for application */
 {
     if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
        return TCL_ERROR;
     }
     if (Tcl_PkgRequire(interp, "Tcl", "8.4", 0) == NULL) {
        return TCL_ERROR;
     }
     if (Tcl_PkgProvide(interp, "curses", "0.8.0") == TCL_ERROR) {
         return TCL_ERROR;
     }

     Tcl_CreateObjCommand(interp, "curses", cursesCmd, 
                         (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);

     curses_start();
     Tcl_CreateExitHandler(curses_exit,(ClientData) NULL);
     return TCL_OK;
 }

 /*
  * curses_exit -- exit handler for curses
  * Results: -- none
  * Side effects: gets out of curses by calling endwin
  */

 static void
 curses_exit (ClientData dummy)
 {
     endwin();
 }


 /* An error reporting routine for varargs results
  * Results : -- always TCL_ERROR, so we can just return
  * the value of this call
  * Side effects: Sets the result in the interpreter.
  */

 #define MAX_ERROR_SIZE   1024

 static int 
 setTclError TCL_VARARGS_DEF (
     Tcl_Interp *,
     i)
 {
     va_list argList;
     char buf[MAX_ERROR_SIZE];
     char *format;

     Tcl_Interp *interp = TCL_VARARGS_START(Tcl_Interp *, i, argList);
     format = va_arg(argList, char *);
     vsnprintf(buf, MAX_ERROR_SIZE, format, argList);
     buf[MAX_ERROR_SIZE-1] = '\0';
     Tcl_SetResult(interp, buf, TCL_VOLATILE);
     return TCL_ERROR;
 } 

 /*
  * curses_start -- init handler for curses. called on loading
  * Results: -- always TCL_OK
  * Side effects: gets into curses mode.
  */

 static int
 curses_start(void)
 {
     initscr();          /* will exit if there is an error */
     if (has_colors())   /* use colors if we have them */
         start_color();
     cbreak();
     noecho();
     nonl();
     intrflush(stdscr,FALSE);
     keypad(stdscr,TRUE);
     return TCL_OK;
 }

 /*
  * --------------------------------------------------------------- 
  * cursesCmd --
  *
  * Implmements the "curses" command.  Doesn't do colors yet
  * 
  * Results:
  *      A standard Tcl result. 
  *
  * Side effects:
  *      See the curses man page.  All side effects are inside the
  *      the library or on the screen!
  * 
  * Usage is listed at the top of this file
  */

 static int 
 cursesCmd (dummy, interp, objc, objv)
     ClientData dummy;
     Tcl_Interp *interp;
     int         objc;
     Tcl_Obj     *CONST objv[];
 {
     int index;

     static CONST char *optionStrings[] = {
         "init", "end", "attr", "move", 
         "puts", "info", "erase", "refresh",
         NULL
     };

     enum options {
         CURSES_INIT, CURSES_END, CURSES_ATTR, CURSES_MOVE, 
         CURSES_PUTS, CURSES_INFO, CURSES_ERASE, CURSES_REFRESH
     };

     static CONST char *attrStrings[] = {
         "standout", "underline", "reverse", 
         "blink", "dim", "bold", "alt", NULL
     };

     enum attrs {
         CURSES_A_STANDOUT, CURSES_A_UNDERLINE, CURSES_A_REVERSE,
         CURSES_A_BLINK,    CURSES_A_DIM,       CURSES_A_BOLD,
         CURSES_A_ALT
     };

     static CONST char *infoStrings[] = {
         "cols", "lines", NULL
     };

     enum infos {
         CURSES_COLS,      CURSES_LINES
     };

     static CONST int attrVals[] = {
         A_STANDOUT,   A_UNDERLINE,   A_REVERSE,
         A_BLINK,      A_DIM,         A_BOLD, 
         A_ALTCHARSET
     };

     if (objc < 2) {
         Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
         return TCL_ERROR;
     }

     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
             &index) != TCL_OK) 
         return TCL_ERROR;

     switch ((enum options) index) {
     case CURSES_INIT: {
         return curses_start();
     }
     case CURSES_END: {
         endwin();
         return TCL_OK;
     }
     case CURSES_ATTR: { 
         int on, index, attr;

         if (objc != 4) {
             Tcl_WrongNumArgs(interp, 2, objv, "boolean attribute");
             return TCL_ERROR;
         }
         if (Tcl_GetBooleanFromObj(interp, objv[2], &on) != TCL_OK) 
             return TCL_ERROR;
         if (Tcl_GetIndexFromObj(interp, objv[3], attrStrings, 
                                 "attribute", 0, &index) != TCL_OK) 
             return TCL_ERROR;   /* perhaps allow an integer here? */
         attr = attrVals[index];
         if (on) {
             attron(attr);
         }  else {
             attroff(attr);
         }
         return TCL_OK;
     }
     case CURSES_MOVE: {
         int row, col;
         if (objc != 4) {
             Tcl_WrongNumArgs(interp, 2, objv, "row col");
             return TCL_ERROR;
         }
         if (Tcl_GetIntFromObj(interp, objv[2], &row) != TCL_OK)
             return TCL_ERROR;
         if (Tcl_GetIntFromObj(interp, objv[3], &col) != TCL_OK)
             return TCL_ERROR;
         move(row, col);
         return TCL_OK;
     }
     case CURSES_PUTS: {
         if (objc != 3) {
             Tcl_WrongNumArgs(interp, 2, objv, "string");
             return TCL_ERROR;
         }
         addstr(Tcl_GetString(objv[2]));
         return TCL_OK;
     }
     case CURSES_INFO: {
         int index;

         if (objc != 3) {
             Tcl_WrongNumArgs(interp, 2, objv, "characteristic");
             return TCL_ERROR;
         }
         if (Tcl_GetIndexFromObj(interp, objv[2], infoStrings,
                                 "characteristic", 0, &index) != TCL_OK)
             return TCL_ERROR;
         switch ((enum infos) index) {
         case CURSES_COLS: {
             Tcl_SetObjResult(interp,Tcl_NewIntObj(COLS));
             return TCL_OK;
         }
         case CURSES_LINES: {
             Tcl_SetObjResult(interp,Tcl_NewIntObj(LINES));
             return TCL_OK;
         }
         default: {
             return setTclError(interp, "Couldn't understand info "
                                "characteristic %d", index);
         }
         }
         return TCL_OK;
     }
     case CURSES_ERASE: {
         if (objc != 2) {
             Tcl_WrongNumArgs(interp, 2, objv, "");
             return TCL_ERROR;
         }
         erase();
         return TCL_OK;
     }
     case CURSES_REFRESH: {
         if (objc != 2) {
             Tcl_WrongNumArgs(interp, 2, objv, "");
             return TCL_ERROR;
         }
         refresh();
         return TCL_OK;
     }
     default: {
         return setTclError(interp, "Couldn't understand enum %d as "
                            "action type", index);
     }
     }
 }

The obvious missing things are color (and because this is curses and NOT ncurses, we don't have mouse and resize handling).

2004-02-12 VI add refresh and timeout (non-blocking) options to command. include linux build instructions


DKF: Arguably, just doing the package require should cause the initialisation of the curses subsystem.


2004-02-13 VI It does. The pkgIndex.tcl is just one line:

 package ifneeded curses 0.7.2 [list load [file join $dir curses.so]]

And it also gets back to normal mode automatically on exit (an exit handler is installed during init).

See a curses screen saver for an example.


2004-08-02 VI And curses digital clock for another


2004-10-12 VI After a chat on the Tcl Chatroom found out that curses getch and curses timeout don't interact well with the Tcl event loop. Instead you set buffering to zero and non-blocking if required and do a read stdin 1. See the curses screen saver or curses digital clock for examples. So removed those two options to the curses command. So it's a little smaller now.


2004-11-07 Luis, I am going crazy with the code here presented because I don't know how to capture a character from the keyboard and act upon the character typed. Here is my code:

 #!/bin/sh
 #\
 exec tclsh $0 ${@}
 package require libterm
 namespace import ::libterm::*
 erase screen both

 proc decolora {esta} {
        switch $esta {
                1 {
                        mv 6,12; rtputs -nonewline "1 Ordenes"
                }
                2 {
                        mv 6,23; rtputs -nonewline "2 Almacen"
                }
                3 {
                        mv 6,34; rtputs -nonewline "3 Calendario"
                }
                4 {
                        mv 6,47; rtputs -nonewline "4 Utilerias"
                }
        }
 }
 set pun 0
 mv 5,10
 rtputs -nonewline "+---------------------------------------------------------+"
 mv 6,10
 rtputs -nonewline "|                                                         |"
 mv 7,10
 rtputs -nonewline "+---------------------------------------------------------+"
 mv 6,12; rtputs -nonewline "1 Ordenes"
 mv 6,23; rtputs -nonewline "2 Almacen"
 mv 6,12; rtputs -nonewline "%B1 Ordenes" 
 mv 6,34; rtputs -nonewline "3 Calendario"
 mv 6,47; rtputs -nonewline "4 Utilerias"

 set fecha [exec date]
 mv 0,0; rtputs -nonewline $fecha
 mv 0,73; rtputs [lindex $fecha 3]

 set esta 1
        fileevent stdin readable {puts "EPALE CABRON TOCO EL TECLADO"; set pungo
 [read stdin 1] ; mv 15 15 ; rtputs $pungo}

 set z 1
 while { $z == 1 } {
        fconfigure stdin -buffering none -blocking 0
        set pun [read stdin 1]
        mv 15,15; rtputs $pun
        switch $pun {
                "1" {
                        decolora $esta
                        mv 6,12; rtputs -nonewline "%B1 Ordenes"
                        set esta 1
                }
                "2" {
                        decolora $esta
                        mv 6,23; rtputs -nonewline "%B2 Almacen"
                        set esta 2
                }
                "3" {
                        decolora $esta
                        mv 6,34; rtputs -nonewline "%B3 Calendario"
                        set esta 3
                }
                "4" {
                        decolora $esta
                        mv 6,47; rtputs -nonewline "%B4 Utilerias"
                        set esta 4
                }
        }
 }

What this code is supposed to do is present a menu at the top then if you press 1 it will show that you have selected the first option of the menu, if you press 2 it will select the second option and so on and so forth, but the problem is that I don't know how to read from the keyboard and switch the variable that receives the input from the keyboard until you press enter. I have been looking all around and have come to nothing, I started with minimalist curses and now I resorted to vt100 library without results yet, can anybody help me please, this is important for me because I don't want to spend more time learning python which offers better curses support thru a module. Worst still I need to get input at a certain position with boundary checks, you can all always program all this if you get the basics but the basics here is inputing each character and being able to use it without having to press enter for each character...


LV Some work has occurred over the years on cTk and perhaps another curses interface or two.


Category Package