Re: [Caml-list] ncurses bindings

[Franck Delaplace <delapla@lami.univ-evry.fr>]

[-- Attachment #1: Type: text/plain, Size: 1001 bytes --]

  > "Jose A. Ortega Ruiz" <jaortega@acm.org> wrote :

 >hi,

 >does anybody know of ocaml bindings for the ncurses lib? (i've looked
 >for them in the caml hump, and googled a little bit, without
 >luck)... and, if not, would you find them useful/interesting? (i'm
 >toying with the idea of writing them myself)

 >thanks for your help,



I've build something for  ncurses  . It is a kernel for a GUI developped
for ncurses.  It is included in Tagcc an environment for gene annotation
written
in Ocaml (http://www.lami.univ-evry.fr/~delapla/tagcc/) .
I've attached the  library (.mli .c)

  The screen may be splitted  into two "windows" : the "menu and status
window" and
the main window  the scrolling  is automatically performed in the main
windows by the curses lib
(Test every keys of the numerical pad)

I hope this will help you

-- 
Franck Delaplace @w3:http://www.lami.univ-evry.fr/~delapla/
Equipe BioInfo, La.M.I-U.M.R 8042 C.N.R.S
523 Place des Terrasses
91025 Evry CEDEX (France)








[-- Attachment #2: curses-1.mli --]
[-- Type: text/plain, Size: 3272 bytes --]

(* interface of curses *)

(* Franck Delaplace : Mai 2001 *)

external initscr   :int->int-> unit    = "cur_initscr"           (* init main  window (header size , nlines ) *)
external win    :unit->unit             = "cur_win"                 (* commute to windows (every command are performed  to windows)*)
external header :unit->unit             = "cur_head"                (* commute to header                                  *)

external endscr    :unit -> unit       = "cur_endscr"         (* close main window *)
external init_pair :int->int->int      = "cur_init_pair"      (* set a color to a pair of color foreground background *)
external init_color:int->int->int->int = "cur_init_pair"      (* init_color i r g b changes a color of number i with r g b parameters *)

external addch     :char->unit         = "cur_addch"          (* add a character to the current cursor position *)
external addstr    :string->unit       = "cur_addstr"         (* add a string *)
external addnstr   :string->int->unit  = "cur_addnstr"    (* add a truncated string of n character *)
external refresh   :unit ->unit        = "cur_refresh"        (* refresh the screen *)
external clear     :unit ->unit        = "cur_clear"          (* clear the screen *)
external move      :int->int->unit     = "cur_move"           (* move the cursor to x y position *)

external color     :int->unit          = "cur_color"          (* set the color predefined by init_pair 
						                 more than  50  colors are already predefined 
						                0 cannot be changed by init_pair  *)


external screenon  : unit -> unit      = "cur_screenon"       (* enable scroll and resize mode *)

external isnew     :unit->bool         = "cur_isnew"          (* check if a resize occurs (initial value true ) *)
external iswait    :unit->bool         = "cur_iswait"         (* check if a key should be pressed before refresh *) 
 
external getx      :unit->int          = "cur_getx"           (* get the number of rows *)

external keepy     :int->unit          = "cur_keepy"          (* keep the y which is directly accessed by pressing insert *)

external keyspace  :unit->unit         = "cur_keyspace"        (* refresh and wait a key  *) 

external normal:unit->unit             = "cur_normal"           (* set to normal (default) mode *)

external bold  :unit->unit             = "cur_bold"            (* bold (bright)  *)
external halfbold  :unit->unit         = "cur_halfbold"        (* bold (bright)  *)
external standout :unit->unit          = "cur_standout"         (*standout*)
external blink :unit->unit             = "cur_blink"            (* blink  *)
external reverse :unit->unit           = "cur_reverse"          (* reverse video  *)


external delch :unit->unit             = "cur_delch"           (* delete the character at the cursor position *) 
external delln :unit->unit             = "cur_delln"           (* delete the line under the  cursor position *) 

external insertln  :unit->unit         = "cur_insertln"        (* insert  a  blank  line
                                                                  above the current line and the bottom line is lost  *)


external flash :unit->unit             = "cur_flash"           (* flash the screen  *) 





[-- Attachment #3: curses-1.c --]
[-- Type: text/plain, Size: 6484 bytes --]

#include <curses.h>
#include <caml/mlvalues.h>


#define max(a,b) ((a>b)?a:b)
#define min(a,b) ((a<b)?a:b)

#define MAXCOLOR 8


/* environnement */

WINDOW *pad=NULL; /* pad */
WINDOW *scr=NULL; /* ecran */

WINDOW *win=NULL; /* fenêtre courante */

int yheader;     /* nombre  de lignes de l'entête */
int xpad;        /* taille  du pad */
int ypad;


int ylast=1;
int ycur=0;     /* curseur pour les menus déroulant */

/* fin --------- */ 
int isnew = TRUE; 
int keyspace = FALSE;

value cur_initscr (value size , value nlines ) 
{
  static int COLOR[MAXCOLOR]=
  {COLOR_BLACK,COLOR_YELLOW,COLOR_CYAN,COLOR_RED,COLOR_GREEN,
   COLOR_MAGENTA,COLOR_BLUE,COLOR_WHITE};
  
  int x,y;  
  getmaxyx(scr,y,x);
  if (!scr)  
    {
      scr = initscr();
 
    }
  else
    {
      wresize(scr,y,x);
    }


      if (has_colors())
	{
	  int i,j;
	  int num = 0;
      
	  start_color();      
	  /* color assignment */
	  for (j= 1;j<MAXCOLOR;j=j++)
	    {
	      num++;
	      init_pair(num,COLOR[j],COLOR[0]);
	    }

	  for (i=1; i<MAXCOLOR;i++)
	    for (j=(i+1)%MAXCOLOR;j!=i;j=(j+1)%MAXCOLOR)
	      {
		if (j != 0) 
		  {
		    num++;
		    init_pair(num,COLOR[i],COLOR[j]);
		  }
		
	      }
	  
	}

  (void)  cbreak();       /* don't wait for NL */
  (void)  noecho();       /* disable echoing while reading char */
  (void)  keypad(scr,TRUE);
  (void)  nodelay(scr,TRUE); 


  /* pad allocation */
  {

    int xold,yold;

    getmaxyx(pad,yold,xold);
    
    ypad = Int_val(nlines);
    xpad = x;

    yheader = Int_val(size);

    
    if (ypad+y != yold || xold != xpad)
      {
	delwin(pad);
	pad = newpad(ypad+y,xpad); 
	ycur = 0;
	ylast= 1;
      }
    win = pad; 
  }
     /* initialize the curses library */
  isnew = FALSE;
  prefresh(pad,ycur,0,yheader,0,y,x);
  doupdate();

  return Val_unit;    
}


value cur_endscr(value unit)  
{ 
  isnew=TRUE;
  if (scr) endwin();
  return Val_unit;
}
  

static short delay = FALSE;

value cur_isnew(value unit) {return (Val_bool(isnew));}

value cur_iswait(value unit) {return (Val_bool(delay));}

value cur_init_color (value i,value r,value g, value b) 
{ if (has_colors()) init_color(Int_val(i),Int_val(r),Int_val(g),Int_val(b));return Val_unit;}

value cur_init_pair (value i,value fg,value bg) 
{ if (has_colors()) init_pair(Int_val(i),Int_val(fg),Int_val(bg));return Val_unit;}



/* commutation entre le header et la fenêtre */
value cur_getx (value unit) { int x,y ; getmaxyx(scr,y,x);  return Val_int(x); }

value cur_win(value unit) { win = pad ; return Val_unit ;}

value cur_head(value unit)  { win = scr ; return Val_unit ;}

value cur_addch(value c)  { waddch(win,Int_val(c)); return Val_unit; }

value cur_addstr(value s) { waddstr (win,String_val(s)); return Val_unit; }

value cur_addnstr(value s, value n) {waddnstr (win,String_val(s), Int_val(n)); return Val_unit; }



#define KEY_SPACE 32
#define KEY_RET 10
value cur_refresh(value unit) 
{
  int key;
  int xscr,yscr;
  int ypage ;
  
  if (delay)  keyspace = TRUE;
  do
    {
      key=getch();
      
      getmaxyx(scr,yscr,xscr);
      
      ypage = yscr-yheader;
      
      switch(key) 
	{
	case   KEY_DOWN  : ycur=min(ycur+1,ypad);break;
	case   KEY_UP    : ycur=max(ycur-1,0) ;break; 
	case   KEY_PPAGE : ycur=max(ycur-(ypage-1),0);break;
	case   KEY_NPAGE : ycur=min(ycur+(ypage-1),ypad-ypage+1);break;
	case   KEY_HOME  : ycur=0;break;
	case   KEY_END   : ycur=ypad-ypage;break;
	case   KEY_IC    : ycur=max(ylast-(ypage/3),1);break;

	  
	case  KEY_RESIZE : 
	  {
	    int x,y;
	    while (getch()==KEY_RESIZE); 
	    getmaxyx(scr,yscr,xscr);
	    getmaxyx(pad,y,x);	  
	    wresize(pad,y,xscr);
	    wresize(scr,yscr,xscr);
	    isnew=TRUE;
	    break;
	  }
	case KEY_DC    : delay = !delay;
	case KEY_RET   :
	case KEY_SPACE : keyspace = FALSE;break;
	  
	}
      
      
      prefresh(pad,ycur,0,yheader,0,yscr,xscr);
      
      doupdate();
    }while(keyspace);
  
  return Val_unit;
	 
  
}

value cur_screenon (value unit) 
{
  int key;
  int xscr,yscr;
  int ypage ;
  
  short modif = FALSE;
  {
    key=getch();
 
    getmaxyx(scr,yscr,xscr);
    
    ypage = yscr-yheader;
    
    switch(key) 
      {
      case   KEY_DOWN  : ycur=min(ycur+1,ypad);modif=TRUE;break;
      case   KEY_UP    : ycur=max(ycur-1,0);modif=TRUE ;break; 
      case   KEY_PPAGE : ycur=max(ycur-(ypage-1),0);;modif=TRUE;break;
      case   KEY_NPAGE : ycur=min(ycur+(ypage-1),ypad-ypage+1);modif=TRUE;break;
      case   KEY_HOME  : ycur=0;modif=TRUE;break;
      case   KEY_END   : ycur=ypad-ypage;modif=TRUE;break;
      case   KEY_IC    : ycur=max(ylast-(ypage/3),1);modif=TRUE;break; 
      case   KEY_DC    : delay = !delay;break;
	
      case  KEY_RESIZE : 
	     {
	       int x,y;
	       while (getch()==KEY_RESIZE); 
	       getmaxyx(scr,yscr,xscr);
	       getmaxyx(pad,y,x);	  
	       wresize(pad,y,xscr);
	       wresize(scr,yscr,xscr);
	       isnew=TRUE;modif=TRUE;
	       break;
	     }
      }
    
    if (modif)
      {
	prefresh(pad,ycur,0,yheader,0,yscr,xscr);
	
	doupdate();
      }

    return Val_unit;
	 
    
  }
}


value cur_keyspace(value unit) {keyspace = TRUE; return (Val_unit) ;}


value cur_keepy(value y) { if (win==pad) ylast = Int_val(y);  return Val_unit;}

value cur_clear (value unit) {wclear(win) ;ylast = 0;ycur = 0; return Val_unit;}

value cur_move(value x,value y) {wmove(win,Int_val(x),Int_val(y)); return Val_unit;}


value cur_normal(value unit)  {wattrset(win,A_NORMAL ) ;return Val_unit;}

value cur_standout (value unit) {wattron(win,A_STANDOUT ) ; return Val_unit;}

value cur_color (value i)     { wcolor_set(win,Int_val(i),NULL);return Val_unit;}

value cur_bold (value unit)  {wattron(win,A_BOLD) ; return Val_unit;}

value cur_halfbold (value unit)  {wattron(win,A_DIM) ; return Val_unit;}

value cur_blink (value unit)  {wattron(win,A_BLINK);return Val_unit;}

value cur_reverse (value unit) {wattron(win,A_REVERSE);return Val_unit;}

value cur_delch (value unit) { wdelch(win) ;  return Val_unit; }

value cur_delln (value unit) { wdeleteln (win) ;  return Val_unit; }

value cur_insertln (value unit) {winsertln(win) ;  return Val_unit; }

value cur_flash (value unit) { flash() ;  return Val_unit; }