* Re: [Caml-list] ncurses bindings
2002-01-08 0:03 [Caml-list] ncurses bindings Jose A. Ortega Ruiz
2002-01-08 9:11 ` Nicolas George
@ 2002-01-08 10:04 ` Franck Delaplace
1 sibling, 0 replies; 4+ messages in thread
From: Franck Delaplace @ 2002-01-08 10:04 UTC (permalink / raw)
To: Jose A. Ortega Ruiz, OCAML
[-- 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; }
^ permalink raw reply [flat|nested] 4+ messages in thread