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.  For Examples See:
[Tcl Curses Menu] [curses digital clock] [curses screen saver]. 
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.  venksi@yahoo.com
 
    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).
----
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

 [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.
----
luis I just turn to python for curses programming (not knowing nothing about python) and I am impressed with the ease of use of python, so if you want to program in curses forget about tcl (except maybe por quick presentation of data with no user interaction) and use python instead.
----
2004-11-10 [VI] : Luis, please see [Tcl Curses Menu] for an example.  And if you don't mind I'd like to move
your code over to a separate page, as this is the page for getting the extension itself.

[Category Package]
----
2004-11-11 12:14am [Luis], no problem please erase it if you want, it is an ugly mess and I just put it here as an example, python is great but is strongly typed and the mysql extensions are not up to par with that of tcl, while on TCL everything is a string and it works great, I did take a look at the Tcl Curses Menu and it looks good to go, will try in more detail tomorrow, if it works fine I will definetely use this one even at the cost of two days of coding in python (somehow I have almost finish porting one big element of my application... which I tought would take 2 weeks...),  also I am planning on creating a whole code base (similar to what you get on Foxplus, dbase) that is programming input fields, forms, scrolling lists, is minimalist curses tcl good enough for all this?, I am particularly intrigue by the use of arrow keys, F1 keys, control+key combinations, my guess is if you can get the raw codes from the keyboard there is no prob., by the way I am doing all this because my users got use to a screen display rather than using the more modern point and click interface, how's that for a weird case... no wonder windows has 90% of PC market, I mean you get use to what they serve you regardless...