From 6e1a33f07115c5cc73a99792bf66eabcb9a8d7be Mon Sep 17 00:00:00 2001 From: demattia Date: Tue, 7 Sep 2004 09:13:21 +0000 Subject: [PATCH] first commit --- c/ncurses.c | 2291 ++++++++++++++++++++++++++++++++++ scheme/ncurses-constants | 160 +++ scheme/ncurses-constants.scm | 132 ++ scheme/ncurses.scm | 1598 ++++++++++++++++++++++++ scheme/scsh-package.scm | 958 ++++++++++++++ 5 files changed, 5139 insertions(+) create mode 100755 c/ncurses.c create mode 100644 scheme/ncurses-constants create mode 100644 scheme/ncurses-constants.scm create mode 100755 scheme/ncurses.scm create mode 100644 scheme/scsh-package.scm diff --git a/c/ncurses.c b/c/ncurses.c new file mode 100755 index 0000000..879ea02 --- /dev/null +++ b/c/ncurses.c @@ -0,0 +1,2291 @@ +#include +#include +#include + +//Makros zum Ein- und Auspacken von Zeigern +#define curses_enter_window(w) s48_enter_integer((long) w) +#define curses_extract_window(w) (WINDOW*) s48_extract_integer(w) +#define curses_enter_screen(s) s48_enter_integer((long) s) +#define curses_extract_screen(s) (SCREEN*) s48_extract_integer(s) +#define curses_extract_file(f) (FILE*) fdopen(s48_extract_integer(f),"rw") +#define curses_enter_chtype(c) s48_enter_char((short) c) +#define curses_extract_chtype(c) (chtype) s48_extract_char(c) + + + +//********************************************************************* +//Bibliotheks-Funktionen +//********************************************************************* + +//ALLGEMEINE: + +//Initialisierung +s48_value scsh_initscr(void) +{ + s48_value res; + WINDOW *stdscr; + stdscr = initscr(); + if (stdscr==NULL) + return S48_FALSE; + else + { + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res=curses_enter_window (stdscr); + S48_GC_UNPROTECT(); + return res; + } +} + + +s48_value scsh_newterm(s48_value type, s48_value outfd, + s48_value infd) +{ + SCREEN *screen; + s48_value res; + S48_DECLARE_GC_PROTECT(4); + S48_GC_PROTECT_4(type, outfd, infd, res); + screen = newterm (s48_extract_string (type), + curses_extract_file (outfd), + curses_extract_file (infd)); + if(screen==NULL) + { + S48_GC_UNPROTECT(); + return S48_FALSE; + } + else + { + res = curses_enter_screen(screen); + S48_GC_UNPROTECT(); + return res; + } +} + + +//Beenden +s48_value scsh_endwin(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (endwin()); + S48_GC_UNPROTECT(); +} + +s48_value scsh_isendwin(void) +{ + return S48_ENTER_BOOLEAN (isendwin()); +} + +s48_value scsh_delscreen(s48_value s) +{ + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(s); + (void) delscreen(curses_extract_screen(s)); + S48_GC_UNPROTECT(); + return S48_UNSPECIFIC; +} + +//Hilfsfunktionen +s48_value scsh_unctrl(s48_value c) +{ + char *res_c; + s48_value res_s; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(c, res_s); + res_c = (char*) unctrl(curses_extract_chtype(c)); + if (res_c==NULL) + { + S48_GC_UNPROTECT(); + return S48_FALSE; + } + else + { + res_s = s48_enter_string (res_c); + S48_GC_UNPROTECT(); + return res_s; + } +} + +s48_value scsh_keyname(s48_value c) +{ + char *key; + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(c, res); + key = (char*) keyname((int) s48_extract_integer(c)); + if (key==NULL) + { + S48_GC_UNPROTECT(); + return S48_FALSE; + } + else + { + res = s48_enter_string(key); + S48_GC_UNPROTECT(); + return res; + } +} + +s48_value scsh_filter(void) +{ + (void) filter(); + return S48_UNSPECIFIC; +} + +s48_value scsh_use_env(s48_value f) +{ + (void) use_env( S48_EXTRACT_BOOLEAN(f)); + return S48_UNSPECIFIC; +} + +s48_value scsh_putwin(s48_value win, s48_value file) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win,file,res); + res = s48_enter_integer (putwin + (curses_extract_window(win), + curses_extract_file(file))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_getwin(s48_value file) +{ + WINDOW *win; + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(file, res); + win = getwin(curses_extract_file(file)); + if(win==NULL) + { + S48_GC_UNPROTECT(); + return S48_FALSE; + } + else + { + res = curses_enter_window(win); + S48_GC_UNPROTECT(); + return res; + } +} + +s48_value scsh_delay_output(s48_value ms) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(ms, res); + res = s48_enter_integer(delay_output (s48_extract_integer(ms))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_flushinp(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer(flushinp()); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_curses_version(void) +{ + s48_value res_s; + char *res = (char*) curses_version(); + if (res==NULL) + return S48_FALSE; + else + { + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res_s); + res_s = s48_enter_string (res); + S48_GC_UNPROTECT(); + return res_s; + } +} + + +//Einstellungen +s48_value scsh_use_default_colors(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer((int)use_default_colors); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_assume_default_colors(s48_value fg, s48_value bg) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer(assume_default_colors + (s48_extract_integer(fg), + s48_extract_integer(bg))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_define_key(s48_value def, s48_value keyc) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (define_key (s48_extract_string (def), + s48_extract_integer (keyc))); + S48_GC_UNPROTECT(); + return res; +} + +//*************************************************************************** + +//TERMINAL + +//Eigenschaften +s48_value scsh_baudrate(void) +{ + int res=baudrate(); + if (res==ERR) + return S48_FALSE; + else + { + s48_value res_s; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res_s); + res_s = s48_enter_integer(res); + S48_GC_UNPROTECT(); + return res_s; + } +} + +s48_value scsh_erasechar(void) +{ + return s48_enter_char((unsigned char) erasechar()); +} + +s48_value scsh_has_ic(void) +{ + return S48_ENTER_BOOLEAN((int)has_ic()); +} + +s48_value scsh_has_il(void) +{ + return S48_ENTER_BOOLEAN((int) has_il()); +} + +s48_value scsh_killchar(void) +{ + return s48_enter_char((unsigned char) killchar()); +} + +s48_value scsh_longname(void) +{ + char *name = longname(); + if (name==NULL) + return S48_FALSE; + else + { + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_string(name); + S48_GC_UNPROTECT(); + return res; + } +} + +s48_value scsh_termname(void) +{ + char *name = termname(); + if (name==NULL) + return S48_FALSE; + else + { + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_string(name); + S48_GC_UNPROTECT(); + return res; + } +} + +s48_value scsh_has_key(s48_value ch) +{ + s48_value res_s; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(ch, res_s); + int res_c=has_key(s48_extract_integer(ch)); + if (res_c==ERR) + { + S48_GC_UNPROTECT(); + return S48_FALSE; + } + else + { + res_s = s48_extract_integer(res_c); + S48_GC_UNPROTECT(); + return res_s; + } +} + +//Farbe +s48_value scsh_start_color() +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer((int) start_color()); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_init_pair(s48_value pair, s48_value f, + s48_value b) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(4); + S48_GC_PROTECT_4(pair, f, b, res); + res = s48_enter_integer((int) init_pair((short) s48_extract_integer(pair), + (short) s48_extract_integer(f), + (short) s48_extract_integer(b))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_init_color(s48_value color, s48_value r, + s48_value g, s48_value b) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(5); + S48_GC_PROTECT_5(color, r, g, b, res); + res = s48_enter_integer(init_color ((short) s48_extract_integer(color), + (short) s48_extract_integer(r), + (short) s48_extract_integer(g), + (short) s48_extract_integer(b))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_has_colors(void) +{ + return S48_ENTER_BOOLEAN((int)has_colors()); +} + +s48_value scsh_can_change_colors(void) +{ + return S48_ENTER_BOOLEAN((int) can_change_color()); +} + +s48_value scsh_color_pair (s48_value num) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(12); + S48_GC_PROTECT_2(num, res); + res = s48_enter_integer( COLOR_PAIR(s48_extract_integer(num))); + S48_GC_UNPROTECT(); + return res; +} + + +//Eingabe: +s48_value scsh_cbreak(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer(cbreak()); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_no_cbreak(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer(nocbreak()); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_echo(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer(echo()); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_noecho(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer(noecho()); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_halfdelay(s48_value tenth) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(tenth, res); + res = s48_enter_integer(halfdelay(s48_extract_integer(tenth))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_intrflush(s48_value win, s48_value bf) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win, bf, res); + res = s48_enter_integer(intrflush (curses_extract_window(win), + S48_EXTRACT_BOOLEAN(bf))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_keypad(s48_value win, s48_value bf) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win, bf, res); + res = s48_enter_integer(keypad (curses_extract_window(win), + S48_EXTRACT_BOOLEAN(bf))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_meta(s48_value win, s48_value bf) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win, bf, res); + res = s48_enter_integer(meta (curses_extract_window(win), + S48_EXTRACT_BOOLEAN(bf))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_nodelay(s48_value win, s48_value bf) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win, bf, res); + res = s48_enter_integer(nodelay(curses_extract_window(win), + S48_EXTRACT_BOOLEAN(bf))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_raw(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer(raw()); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_noraw(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer(noraw()); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_qiflush(void) +{ + (void) qiflush(); + return S48_UNSPECIFIC; +} + +s48_value scsh_noqiflush(void) +{ + (void) noqiflush(); + return S48_UNSPECIFIC; +} + + +//Terminalfunktionen +s48_value scsh_beep(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer(beep()); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_flash(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer(flash()); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_def_prog_mode(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer(def_prog_mode()); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_def_shell_mode(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer(def_shell_mode()); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_reset_prog_mode(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer(reset_prog_mode()); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_reset_shell_mode(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer(reset_shell_mode()); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_resetty(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer(resetty()); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_savetty(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer(savetty()); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_curs_set(s48_value visibility) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(visibility, res); + res = s48_enter_integer(curs_set(s48_extract_integer(visibility))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_napms(s48_value ms) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(ms, res); + res = s48_enter_integer(napms(s48_extract_integer(ms))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_mcprint(s48_value data, s48_value len) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(data, len, res); + res = s48_enter_integer(mcprint(s48_extract_string (data), + s48_extract_integer(len))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_is_term_resized(s48_value lines, s48_value columns) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(lines, columns, res); + res = S48_ENTER_BOOLEAN(is_term_resized + (s48_extract_integer(lines), + s48_extract_integer(columns))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_resize_term(s48_value lines, s48_value columns) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(lines, columns, res); + res = s48_enter_integer(resize_term + (s48_extract_integer(lines), + s48_extract_integer(columns))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_resizeterm(s48_value lines, s48_value columns) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(lines, columns, res); + res = s48_enter_integer(resizeterm + (s48_extract_integer(lines), + s48_extract_integer(columns))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_scr_dump(s48_value filename) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(filename, res); + res = s48_enter_integer(scr_dump + (s48_extract_string (filename))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_scr_restore(s48_value filename) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(filename, res); + res = s48_enter_integer(scr_restore + (s48_extract_string (filename))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_scr_init(s48_value filename) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(filename, res); + res = s48_enter_integer(scr_init + (s48_extract_string (filename))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_scr_set(s48_value filename) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(filename, res); + res = s48_enter_integer(scr_set + (s48_extract_string (filename))); + S48_GC_UNPROTECT(); + return res; +} + + +//mehrere Terminals +s48_value scsh_set_term(s48_value new) +{ + SCREEN *res; + s48_value res_s; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(new, res_s); + res= set_term (curses_extract_screen(new)); + if(res==NULL) + { + S48_GC_UNPROTECT(); + return S48_FALSE; + } + else + { + res_s = curses_enter_screen(res); + S48_GC_UNPROTECT(); + return res_s; + } +} + +//************************************************************************* + +//FENSTER + +//Allgemeine: +s48_value scsh_newwin(s48_value height, s48_value width, + s48_value starty, s48_value startx) +{ + WINDOW *win; + s48_value res; + S48_DECLARE_GC_PROTECT(5); + S48_GC_PROTECT_5(height,width,starty,startx, res); + win=(newwin ((int) s48_extract_integer(height) + ,(int) s48_extract_integer(width) + ,(int) s48_extract_integer(starty) + ,(int) s48_extract_integer(startx))); + + if (win==NULL) + { + S48_GC_UNPROTECT(); + return S48_FALSE; + } + else + { + res = curses_enter_window(win); + S48_GC_UNPROTECT(); + return res; + } +} + +s48_value scsh_delwin(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = s48_enter_integer(delwin (curses_extract_window (win))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_mvwin(s48_value win, s48_value y, s48_value x) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(4); + S48_GC_PROTECT_4(win, y, x, res); + res = s48_enter_integer(mvwin (curses_extract_window (win), + s48_extract_integer(y), + s48_extract_integer(x))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_subwin(s48_value orig, s48_value nlines, + s48_value ncols, s48_value begin_y, + s48_value begin_x) +{ + WINDOW *res; + s48_value res_s; + S48_DECLARE_GC_PROTECT(6); + S48_GC_PROTECT_6(orig, nlines, ncols, begin_y, begin_x, res_s); + res=subwin (curses_extract_window (orig), + s48_extract_integer(nlines), + s48_extract_integer(ncols), + s48_extract_integer(begin_y), + s48_extract_integer(begin_x)); + if(res==NULL) + { + S48_GC_UNPROTECT(); + return S48_FALSE; + } + else + { + res_s = curses_enter_window(res); + S48_GC_UNPROTECT(); + return res_s; + } +} + +s48_value scsh_derwin(s48_value orig, s48_value nlines, + s48_value ncols, s48_value begin_y, + s48_value begin_x) +{ + WINDOW *res; + s48_value res_s; + S48_DECLARE_GC_PROTECT(6); + S48_GC_PROTECT_6(orig, nlines, ncols, begin_y, begin_x, res_s); + res=derwin (curses_extract_window (orig), + s48_extract_integer(nlines), + s48_extract_integer(ncols), + s48_extract_integer(begin_y), + s48_extract_integer(begin_x)); + if(res==NULL) + { + S48_GC_UNPROTECT(); + return S48_FALSE; + } + else + { + res_s = curses_enter_window(res); + S48_GC_UNPROTECT(); + return res_s; + } +} + +s48_value scsh_mvderwin(s48_value win, s48_value par_y, + s48_value par_x) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(4); + S48_GC_PROTECT_4(win, par_y, par_x, res); + res = s48_enter_integer (mvderwin(curses_extract_window (win), + s48_extract_integer(par_y), + s48_extract_integer(par_x))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_dupwin(s48_value win) +{ + WINDOW *res; + s48_value res_s; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res_s); + res=dupwin(curses_extract_window(win)); + if(res==NULL) + { + S48_GC_UNPROTECT(); + return S48_FALSE; + } + else + { + res_s = curses_enter_window(res); + S48_GC_UNPROTECT(); + return res_s; + } +} + +s48_value scsh_wsyncup(s48_value win) +{ + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(win); + (void) wsyncup(curses_extract_window(win)); + S48_GC_UNPROTECT(); + return S48_UNSPECIFIC; +} + +s48_value scsh_wcursyncup(s48_value win) +{ + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(win); + (void) wcursyncup(curses_extract_window(win)); + S48_GC_UNPROTECT(); + return S48_UNSPECIFIC; +} + +s48_value scsh_wsyncdown(s48_value win) +{ + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(win); + (void) wsyncdown(curses_extract_window(win)); + S48_GC_UNPROTECT(); + return S48_UNSPECIFIC; +} + +s48_value scsh_syncok(s48_value win, s48_value bf) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win, bf, res); + res = s48_enter_integer (syncok(curses_extract_window (win), + S48_EXTRACT_BOOLEAN(bf))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_wrefresh(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = s48_enter_integer(wrefresh(curses_extract_window(win))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_wnoutrefresh(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = s48_enter_integer(wnoutrefresh(curses_extract_window(win))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_redrawwin(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = s48_enter_integer(redrawwin(curses_extract_window(win))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_doupdate(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer(doupdate()); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_wredrawln(s48_value win, s48_value beg_line, + s48_value num_lines) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(4); + S48_GC_PROTECT_4(win, beg_line, num_lines, res); + res = s48_enter_integer(wredrawln(curses_extract_window(win), + s48_extract_integer(beg_line), + s48_extract_integer(num_lines))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_gety(s48_value win) +{ + int y=0; + int x=0; + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + getyx(curses_extract_window(win), y, x); + res = s48_enter_integer(y); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_getx(s48_value win) +{ + int y = 0; + int x = 0; + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + getyx(curses_extract_window(win), y, x); + res = s48_enter_integer(x); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_getmaxy(s48_value win) +{ + int y = 0; + int x = 0; + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + getmaxyx(curses_extract_window(win), y, x); + res = s48_enter_integer(y); + S48_GC_UNPROTECT(); + return res; +} + + +s48_value scsh_getmaxx(s48_value win) +{ + int y = 0; + int x = 0; + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + getmaxyx(curses_extract_window(win), y, x); + res = s48_enter_integer(x); + S48_GC_UNPROTECT(); + return res; +} +/* +s48_value scsh_getyx(s48_value win, s48_value y, s48_value x) +{ + getyx(curses_extract_window(win), + s48_extract_integer(y), + s48_extract_integer(x)); + return S48_UNSPECIFIC; +} + + +s48_value scsh_getparyx(s48_value win, s48_value y, s48_value x) +{ + (void) getparyx(curses_extract_window(win), + s48_extract_integer(y), + s48_extract_integer(x)); + return S48_UNSPECIFIC; +} + +s48_value scsh_getbegyx(s48_value win, s48_value y, s48_value x) +{ + (void) getbegyx(curses_extract_window(win), + s48_extract_integer(y), + s48_extract_integer(x)); + return S48_UNSPECIFIC; +} + +s48_value scsh_getmaxyx(s48_value win, s48_value y, s48_value x) +{ + (void) getmaxyx(curses_extract_window(win), + s48_extract_integer(y), + s48_extract_integer(x)); + return S48_UNSPECIFIC; +} +*/ + +s48_value scsh_wresize(s48_value win, s48_value lines, + s48_value columns) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(4); + S48_GC_PROTECT_4(win, lines, columns, res); + res = s48_enter_integer(wresize + (curses_extract_window(win), + s48_extract_integer(lines), + s48_extract_integer(columns))); + S48_GC_UNPROTECT(); + return res; +} + + +//Ausgabe-Einstellungen + +s48_value scsh_idlok(s48_value win, s48_value bf) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win,bf , res); + res = s48_enter_integer(idlok + (curses_extract_window(win), + S48_EXTRACT_BOOLEAN(bf))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_leaveok(s48_value win, s48_value bf) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win ,bf , res); + res = s48_enter_integer(leaveok + (curses_extract_window(win), + S48_EXTRACT_BOOLEAN(bf))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_scrollok(s48_value win, s48_value bf) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win ,bf , res); + res = s48_enter_integer(scrollok + (curses_extract_window(win), + S48_EXTRACT_BOOLEAN(bf))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_idcok(s48_value win, s48_value bf) +{ + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win ,bf); + (void) idcok(curses_extract_window(win), S48_EXTRACT_BOOLEAN(bf)); + S48_GC_UNPROTECT(); + return S48_UNSPECIFIC; +} + +s48_value scsh_immedok(s48_value win, s48_value bf) +{ + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win ,bf); + (void) immedok(curses_extract_window(win), S48_EXTRACT_BOOLEAN(bf)); + S48_GC_UNPROTECT(); + return S48_UNSPECIFIC; +} + +s48_value scsh_wsetscrreg(s48_value win, s48_value top, + s48_value bot) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(4); + S48_GC_PROTECT_4(win, top, bot, res); + res = s48_enter_integer(wsetscrreg + (curses_extract_window(win), + s48_extract_integer(top), + s48_extract_integer(bot))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_nl(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer(nl()); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_nonl(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer(nonl()); + S48_GC_UNPROTECT(); + return res; +} + +//Text anzeigen: +s48_value scsh_waddch(s48_value win, s48_value ch) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win, ch, res); + res = s48_enter_integer(waddch + (curses_extract_window(win), + curses_extract_chtype(ch))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_wechochar(s48_value win, s48_value ch) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win, ch, res); + res = s48_enter_integer(wechochar + (curses_extract_window(win), + curses_extract_chtype(ch))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_waddstr(s48_value win, s48_value str) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win, str, res); + res = s48_enter_integer (waddstr + (curses_extract_window(win), + s48_extract_string(str))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_waddnstr(s48_value win, s48_value str, + s48_value n) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(4); + S48_GC_PROTECT_4(win, str, n, res); + res = s48_enter_integer (waddnstr + (curses_extract_window(win), + s48_extract_string(str), + s48_extract_integer(n))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_winsch(s48_value win, s48_value ch) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win, ch, res); + res = s48_enter_integer(winsch + (curses_extract_window(win), + curses_extract_chtype(ch))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_winsstr(s48_value win, s48_value str) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win, str, res); + res = s48_enter_integer (winsstr + (curses_extract_window(win), + s48_extract_string(str))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_winsnstr(s48_value win, s48_value str, + s48_value n) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(4); + S48_GC_PROTECT_4(win, str, n, res); + res = s48_enter_integer (winsnstr + (curses_extract_window(win), + s48_extract_string(str), + s48_extract_integer(n))); + S48_GC_UNPROTECT(); + return res; +} + +//Attribute +s48_value scsh_wattroff(s48_value win, s48_value attr) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win, attr, res); + res = s48_enter_integer (wattroff(curses_extract_window (win), + s48_extract_integer(attr))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_wattron(s48_value win, s48_value attr) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win, attr, res); + res = s48_enter_integer (wattron(curses_extract_window (win), + s48_extract_integer(attr))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_wattrset(s48_value win, s48_value attr) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win, attr, res); + res = s48_enter_integer (wattrset(curses_extract_window (win), + s48_extract_integer(attr))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_wstandend(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = s48_enter_integer (wstandend(curses_extract_window (win))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_wstandout(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = s48_enter_integer (wstandout(curses_extract_window (win))); + S48_GC_UNPROTECT(); + return res; +} + + +//Background: +s48_value scsh_wbkgdset(s48_value win, s48_value ch) +{ + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, ch); + (void) wbkgdset(curses_extract_window(win), + curses_extract_chtype(ch)); + S48_GC_UNPROTECT(); + return S48_UNSPECIFIC; +} + +s48_value scsh_wbkgd(s48_value win, s48_value ch) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win, ch, res); + res = s48_enter_integer( wbkgd + (curses_extract_window(win), + curses_extract_chtype(ch))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_getbkgd(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = curses_enter_chtype( getbkgd + (curses_extract_window(win))); + S48_GC_UNPROTECT(); + return res; +} + + +//Umrandung des Fensters +s48_value scsh_wborder(s48_value win, s48_value ls, + s48_value rs, s48_value ts, + s48_value bs, s48_value tl, + s48_value tr, s48_value bl, + s48_value br) +{ + return s48_enter_integer(wborder + (curses_extract_window(win), + curses_extract_chtype(ls), + curses_extract_chtype(rs), + curses_extract_chtype(ts), + curses_extract_chtype(bs), + curses_extract_chtype(tl), + curses_extract_chtype(tr), + curses_extract_chtype(bl), + curses_extract_chtype(br))); +} + +s48_value scsh_box(s48_value win, s48_value verch, s48_value horch) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(4); + S48_GC_PROTECT_4(win, verch, horch, res); + res = s48_enter_integer ( box(curses_extract_window(win), + curses_extract_chtype(verch), + curses_extract_chtype(horch))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_whline(s48_value win, s48_value ch, s48_value n) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(4); + S48_GC_PROTECT_4(win, ch, n, res); + res = s48_enter_integer (whline(curses_extract_window(win), + curses_extract_chtype(ch), + s48_extract_integer(n))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_wvline(s48_value win, s48_value ch, s48_value n) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(4); + S48_GC_PROTECT_4(win, ch, n, res); + res = s48_enter_integer ( wvline(curses_extract_window(win), + curses_extract_chtype(ch), + s48_extract_integer(n))); + S48_GC_UNPROTECT(); + return res; +} + + +//Cursor: + +s48_value scsh_scroll(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = s48_enter_integer( scroll (curses_extract_window(win))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_wscrl(s48_value win, s48_value n) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win, n, res); + res = s48_enter_integer( wscrl + (curses_extract_window(win), + s48_extract_integer(n))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_wmove(s48_value win, s48_value y, + s48_value x) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(4); + S48_GC_PROTECT_4(win, y, x, res); + res = s48_enter_integer( wmove + (curses_extract_window(win), + s48_extract_integer(y), + s48_extract_integer(x))); + S48_GC_UNPROTECT(); + return res; +} + +//Eingabe + +s48_value scsh_wgetch(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = s48_enter_integer (wgetch (curses_extract_window(win))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_winch(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = curses_enter_chtype (winch (curses_extract_window(win))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_winstr(s48_value win) +{ + char *str; + int status; + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + status = winstr (curses_extract_window(win), str); + if(status==ERR) + { + S48_GC_UNPROTECT(); + return S48_FALSE; + } + else + { + res = s48_enter_string(str); + S48_GC_UNPROTECT(); + return res; + } +} + +s48_value scsh_winnstr(s48_value win, s48_value n) +{ + char *str; + int status; + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win, n, res); + status = winnstr (curses_extract_window(win), str, + s48_extract_integer(n)); + if(status==ERR) + { + S48_GC_UNPROTECT(); + return S48_FALSE; + } + else + { + res = s48_enter_string(str); + S48_GC_UNPROTECT(); + return res; + } +} + + + +//Loeschen: +s48_value scsh_werase(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = s48_enter_integer( werase (curses_extract_window(win))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_wclear(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = s48_enter_integer( wclear (curses_extract_window(win))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_wclrtobot(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = s48_enter_integer( wclrtobot (curses_extract_window(win))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_wclrtoeol(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = s48_enter_integer( wclrtoeol (curses_extract_window(win))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_clearok(s48_value win, s48_value bf) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win, bf, res); + res = s48_enter_integer( clearok (curses_extract_window(win), + S48_EXTRACT_BOOLEAN(bf))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_wdelch(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = s48_enter_integer( wdelch (curses_extract_window(win))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_wdeleteln(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = s48_enter_integer( wdeleteln (curses_extract_window(win))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_winsertln(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = s48_enter_integer( winsertln (curses_extract_window(win))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_winsdelln(s48_value win, s48_value n) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win, n, res); + res = s48_enter_integer( winsdelln + (curses_extract_window(win), + s48_extract_integer(n))); + S48_GC_UNPROTECT(); + return res; +} + + +//mehrere Fenster + +s48_value scsh_overlay(s48_value srcwin, s48_value dstwin) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(srcwin, dstwin, res); + res = s48_enter_integer (overlay(curses_extract_window(srcwin), + curses_extract_window(dstwin))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_overwrite(s48_value srcwin, s48_value dstwin) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(srcwin, dstwin, res); + res = s48_enter_integer (overwrite(curses_extract_window(srcwin), + curses_extract_window(dstwin))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_copywin(s48_value srcwin, s48_value dstwin, + s48_value sminrow, s48_value smincol, + s48_value dminrow, s48_value dmincol, + s48_value dmaxrow, s48_value dmaxcol, + s48_value overlay) +{ + S48_DECLARE_GC_PROTECT(9); + S48_GC_PROTECT_9(srcwin, dstwin, sminrow, smincol, dminrow, dmincol, + dmaxrow, dmaxcol, overlay); + int res = copywin(curses_extract_window(srcwin), + curses_extract_window(dstwin), + s48_extract_integer(sminrow), + s48_extract_integer(smincol), + s48_extract_integer(dminrow), + s48_extract_integer(dmincol), + s48_extract_integer(dmaxrow), + s48_extract_integer(dmaxcol), + s48_extract_integer(overlay)); + S48_GC_UNPROTECT(); + return s48_enter_integer(res); +} + + +//Eigenschaften + +s48_value scsh_touchline(s48_value win, s48_value start, + s48_value count) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(4); + S48_GC_PROTECT_4(win, start, count, res); + res = s48_enter_integer(touchline + (curses_extract_window(win), + s48_extract_integer(start), + s48_extract_integer(count))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_touchwin(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = s48_enter_integer(touchwin + (curses_extract_window(win))); + + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_untouchwin(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = s48_enter_integer(untouchwin + (curses_extract_window(win))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_wtouchln(s48_value win, s48_value y, + s48_value n, s48_value changed) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(5); + S48_GC_PROTECT_5(win, y, n, changed, res); + res = s48_enter_integer(wtouchln + (curses_extract_window(win), + s48_extract_integer(y), + s48_extract_integer(n), + s48_extract_integer(changed))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_is_linetouched(s48_value win, s48_value line) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(win, line, res); + res = S48_ENTER_BOOLEAN(is_linetouched + (curses_extract_window(win), + s48_extract_integer(line))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_is_wintouched(s48_value win) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win, res); + res = S48_ENTER_BOOLEAN(is_wintouched + (curses_extract_window(win))); + S48_GC_UNPROTECT(); + return res; +} + +//************************************************************************* + +//PADS + +s48_value scsh_newpad(s48_value nlines, s48_value ncols) +{ + WINDOW *pad; + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(nlines, ncols, res); + pad=(newpad ((int) s48_extract_integer(nlines) + ,(int) s48_extract_integer(ncols))); + if (pad==NULL) + { + S48_GC_UNPROTECT(); + return S48_FALSE; + } + else + { + res = curses_enter_window(pad); + S48_GC_UNPROTECT(); + return res; + } +} + +s48_value scsh_subpad(s48_value win, s48_value nlines, + s48_value ncols, s48_value begin_y, + s48_value begin_x) +{ + WINDOW *pad; + s48_value res; + S48_DECLARE_GC_PROTECT(6); + S48_GC_PROTECT_6(win, nlines, ncols, begin_y, begin_x, res); + pad=(subpad (curses_extract_window(win), + (int) s48_extract_integer(nlines), + (int) s48_extract_integer(ncols), + (int) s48_extract_integer(begin_y), + (int) s48_extract_integer(begin_x))); + if (pad==NULL) + { + S48_GC_UNPROTECT(); + return S48_FALSE; + } + else + { + res = curses_enter_window(pad); + S48_GC_UNPROTECT(); + return res; + } +} + + +s48_value scsh_prefresh(s48_value orig, s48_value pminrow, + s48_value pmincol, s48_value sminrow, + s48_value smincol, s48_value smaxrow, + s48_value smaxcol) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(8); + S48_GC_PROTECT_8(orig, pminrow, pmincol, sminrow, smincol, smaxrow, + smaxcol, res); + res = s48_enter_integer (prefresh(curses_extract_window(orig), + s48_extract_integer(pminrow), + s48_extract_integer(pmincol), + s48_extract_integer(sminrow), + s48_extract_integer(smincol), + s48_extract_integer(smaxrow), + s48_extract_integer(smaxcol))); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_pnoutrefresh(s48_value orig, s48_value pminrow, + s48_value pmincol, s48_value sminrow, + s48_value smincol, s48_value smaxrow, + s48_value smaxcol) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(8); + S48_GC_PROTECT_8(orig, pminrow, pmincol, sminrow, smincol, smaxrow, + smaxcol, res); + res = s48_enter_integer (pnoutrefresh(curses_extract_window(orig), + s48_extract_integer(pminrow), + s48_extract_integer(pmincol), + s48_extract_integer(sminrow), + s48_extract_integer(smincol), + s48_extract_integer(smaxrow), + s48_extract_integer(smaxcol))); + S48_GC_UNPROTECT(); + return res; +} + + +s48_value scsh_pechochar(s48_value pad, s48_value ch) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(pad, ch, res); + res = s48_enter_integer (pechochar(curses_extract_window(pad), + curses_extract_chtype(ch))); + S48_GC_UNPROTECT(); + return res; +} + +//************************************************************************* + +//KONSTANTEN: + +//Standard-Screen +s48_value scsh_stdscr(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = curses_enter_window (stdscr); + S48_GC_UNPROTECT(); + return res; +} + +//Lines-Cols +s48_value scsh_LINES(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = curses_enter_window (LINES); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_COLS(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = curses_enter_window (COLS); + S48_GC_UNPROTECT(); + return res; +} + + +//Attribute +s48_value scsh_A_NORMAL(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (A_NORMAL); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_A_STANDOUT(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (A_STANDOUT); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_A_UNDERLINE(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (A_UNDERLINE); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_A_REVERSE(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (A_REVERSE); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_A_BLINK(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (A_BLINK); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_A_DIM(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (A_DIM); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_A_BOLD(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (A_BOLD); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_A_PROTECT(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (A_PROTECT); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_A_INVIS(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (A_INVIS); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_A_ALTCHARSET(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (A_ALTCHARSET); + S48_GC_UNPROTECT(); + return res; +} + +//Farben: + +s48_value scsh_COLOR_BLACK(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (COLOR_BLACK); + S48_GC_UNPROTECT(); + return res; +} +s48_value scsh_COLOR_RED(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (COLOR_RED); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_COLOR_GREEN(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (COLOR_GREEN); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_COLOR_YELLOW(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (COLOR_YELLOW); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_COLOR_BLUE(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (COLOR_BLUE); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_COLOR_MAGENTA(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (COLOR_MAGENTA); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_COLOR_CYAN(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (COLOR_CYAN); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_COLOR_WHITE(void) +{ + s48_value res; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + res = s48_enter_integer (COLOR_WHITE); + S48_GC_UNPROTECT(); + return res; +} + + +s48_value scsh_wprintw(s48_value win, s48_value string) +{ + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(win,string); + int res = wprintw(curses_extract_window(win), + s48_extract_string(string)); + S48_GC_UNPROTECT(); + return s48_enter_integer(res); +} + + + + + + + + + + + + + + +s48_value scsh_printw(s48_value text) +{ + (void) printw(s48_extract_string(text)); + return S48_UNSPECIFIC; +} + +s48_value scsh_refresh(void) +{ + (void) refresh(); + return S48_UNSPECIFIC; +} + + +s48_value scsh_clear(void) +{ + (void) clear(); + return S48_UNSPECIFIC; +} + + + +void s48_init_curses(void) +{ + + + S48_EXPORT_FUNCTION(scsh_initscr); + S48_EXPORT_FUNCTION(scsh_newterm); + + S48_EXPORT_FUNCTION(scsh_endwin); + S48_EXPORT_FUNCTION(scsh_isendwin); + S48_EXPORT_FUNCTION(scsh_delscreen); + + S48_EXPORT_FUNCTION(scsh_unctrl); + S48_EXPORT_FUNCTION(scsh_keyname); + S48_EXPORT_FUNCTION(scsh_filter); + S48_EXPORT_FUNCTION(scsh_use_env); + S48_EXPORT_FUNCTION(scsh_putwin); + S48_EXPORT_FUNCTION(scsh_getwin); + S48_EXPORT_FUNCTION(scsh_delay_output); + S48_EXPORT_FUNCTION(scsh_flushinp); + S48_EXPORT_FUNCTION(scsh_curses_version); + + S48_EXPORT_FUNCTION(scsh_use_default_colors); + S48_EXPORT_FUNCTION(scsh_assume_default_colors); + S48_EXPORT_FUNCTION(scsh_define_key); + + S48_EXPORT_FUNCTION(scsh_baudrate); + S48_EXPORT_FUNCTION(scsh_erasechar); + S48_EXPORT_FUNCTION(scsh_has_ic); + S48_EXPORT_FUNCTION(scsh_has_il); + S48_EXPORT_FUNCTION(scsh_killchar); + S48_EXPORT_FUNCTION(scsh_longname); + S48_EXPORT_FUNCTION(scsh_termname); + S48_EXPORT_FUNCTION(scsh_has_key); + + S48_EXPORT_FUNCTION(scsh_start_color); + S48_EXPORT_FUNCTION(scsh_init_pair); + S48_EXPORT_FUNCTION(scsh_init_color); + S48_EXPORT_FUNCTION(scsh_has_colors); + S48_EXPORT_FUNCTION(scsh_can_change_colors); + S48_EXPORT_FUNCTION(scsh_color_pair); + + S48_EXPORT_FUNCTION(scsh_cbreak); + S48_EXPORT_FUNCTION(scsh_no_cbreak); + S48_EXPORT_FUNCTION(scsh_echo); + S48_EXPORT_FUNCTION(scsh_noecho); + S48_EXPORT_FUNCTION(scsh_halfdelay); + S48_EXPORT_FUNCTION(scsh_intrflush); + S48_EXPORT_FUNCTION(scsh_keypad); + S48_EXPORT_FUNCTION(scsh_meta); + S48_EXPORT_FUNCTION(scsh_nodelay); + S48_EXPORT_FUNCTION(scsh_raw); + S48_EXPORT_FUNCTION(scsh_noraw); + S48_EXPORT_FUNCTION(scsh_qiflush); + S48_EXPORT_FUNCTION(scsh_noqiflush); + + S48_EXPORT_FUNCTION(scsh_beep); + S48_EXPORT_FUNCTION(scsh_flash); + S48_EXPORT_FUNCTION(scsh_def_prog_mode); + S48_EXPORT_FUNCTION(scsh_def_shell_mode); + S48_EXPORT_FUNCTION(scsh_reset_prog_mode); + S48_EXPORT_FUNCTION(scsh_reset_shell_mode); + S48_EXPORT_FUNCTION(scsh_resetty); + S48_EXPORT_FUNCTION(scsh_savetty); + S48_EXPORT_FUNCTION(scsh_curs_set); + S48_EXPORT_FUNCTION(scsh_napms); + S48_EXPORT_FUNCTION(scsh_mcprint); + S48_EXPORT_FUNCTION(scsh_is_term_resized); + S48_EXPORT_FUNCTION(scsh_resize_term); + S48_EXPORT_FUNCTION(scsh_resizeterm); + S48_EXPORT_FUNCTION(scsh_scr_dump); + S48_EXPORT_FUNCTION(scsh_scr_restore); + S48_EXPORT_FUNCTION(scsh_scr_init); + S48_EXPORT_FUNCTION(scsh_scr_set); + + S48_EXPORT_FUNCTION(scsh_set_term); + + S48_EXPORT_FUNCTION(scsh_newwin); + S48_EXPORT_FUNCTION(scsh_delwin); + S48_EXPORT_FUNCTION(scsh_mvwin); + S48_EXPORT_FUNCTION(scsh_subwin); + S48_EXPORT_FUNCTION(scsh_derwin); + S48_EXPORT_FUNCTION(scsh_mvderwin); + S48_EXPORT_FUNCTION(scsh_dupwin); + S48_EXPORT_FUNCTION(scsh_wsyncup); + S48_EXPORT_FUNCTION(scsh_wcursyncup); + S48_EXPORT_FUNCTION(scsh_wsyncdown); + S48_EXPORT_FUNCTION(scsh_syncok); + S48_EXPORT_FUNCTION(scsh_wrefresh); + S48_EXPORT_FUNCTION(scsh_wnoutrefresh); + S48_EXPORT_FUNCTION(scsh_redrawwin); + S48_EXPORT_FUNCTION(scsh_doupdate); + S48_EXPORT_FUNCTION(scsh_wredrawln); + /*S48_EXPORT_FUNCTION(scsh_getyx); + S48_EXPORT_FUNCTION(scsh_getparyx); + S48_EXPORT_FUNCTION(scsh_getbegyx); + S48_EXPORT_FUNCTION(scsh_getmaxyx);*/ + S48_EXPORT_FUNCTION(scsh_gety); + S48_EXPORT_FUNCTION(scsh_getx); + S48_EXPORT_FUNCTION(scsh_getmaxy); + S48_EXPORT_FUNCTION(scsh_getmaxx); + S48_EXPORT_FUNCTION(scsh_wresize); + + S48_EXPORT_FUNCTION(scsh_idlok); + S48_EXPORT_FUNCTION(scsh_leaveok); + S48_EXPORT_FUNCTION(scsh_scrollok); + S48_EXPORT_FUNCTION(scsh_idcok); + S48_EXPORT_FUNCTION(scsh_immedok); + S48_EXPORT_FUNCTION(scsh_wsetscrreg); + S48_EXPORT_FUNCTION(scsh_nl); + S48_EXPORT_FUNCTION(scsh_nonl); + + S48_EXPORT_FUNCTION(scsh_waddch); + S48_EXPORT_FUNCTION(scsh_wechochar); + S48_EXPORT_FUNCTION(scsh_waddstr); + S48_EXPORT_FUNCTION(scsh_waddnstr); + S48_EXPORT_FUNCTION(scsh_winsch); + S48_EXPORT_FUNCTION(scsh_winsstr); + S48_EXPORT_FUNCTION(scsh_winsnstr); + + S48_EXPORT_FUNCTION(scsh_wattroff); + S48_EXPORT_FUNCTION(scsh_wattron); + S48_EXPORT_FUNCTION(scsh_wattrset); + S48_EXPORT_FUNCTION(scsh_wstandend); + S48_EXPORT_FUNCTION(scsh_wstandout); + + S48_EXPORT_FUNCTION(scsh_wbkgdset); + S48_EXPORT_FUNCTION(scsh_wbkgd); + S48_EXPORT_FUNCTION(scsh_getbkgd); + + S48_EXPORT_FUNCTION(scsh_wborder); + S48_EXPORT_FUNCTION(scsh_box); + S48_EXPORT_FUNCTION(scsh_whline); + S48_EXPORT_FUNCTION(scsh_wvline); + + S48_EXPORT_FUNCTION(scsh_scroll); + S48_EXPORT_FUNCTION(scsh_wscrl); + S48_EXPORT_FUNCTION(scsh_wmove); + + S48_EXPORT_FUNCTION(scsh_wgetch); + S48_EXPORT_FUNCTION(scsh_winch); + S48_EXPORT_FUNCTION(scsh_winstr); + S48_EXPORT_FUNCTION(scsh_winnstr); + + + S48_EXPORT_FUNCTION(scsh_werase); + S48_EXPORT_FUNCTION(scsh_wclear); + S48_EXPORT_FUNCTION(scsh_wclrtobot); + S48_EXPORT_FUNCTION(scsh_wclrtoeol); + S48_EXPORT_FUNCTION(scsh_clearok); + S48_EXPORT_FUNCTION(scsh_wdelch); + S48_EXPORT_FUNCTION(scsh_wdeleteln); + S48_EXPORT_FUNCTION(scsh_winsertln); + S48_EXPORT_FUNCTION(scsh_winsdelln); + + S48_EXPORT_FUNCTION(scsh_overlay); + S48_EXPORT_FUNCTION(scsh_overwrite); + S48_EXPORT_FUNCTION(scsh_copywin); + + S48_EXPORT_FUNCTION(scsh_touchline); + S48_EXPORT_FUNCTION(scsh_touchwin); + S48_EXPORT_FUNCTION(scsh_untouchwin); + S48_EXPORT_FUNCTION(scsh_wtouchln); + S48_EXPORT_FUNCTION(scsh_is_linetouched); + S48_EXPORT_FUNCTION(scsh_is_wintouched); + + + S48_EXPORT_FUNCTION(scsh_newpad); + S48_EXPORT_FUNCTION(scsh_subpad); + S48_EXPORT_FUNCTION(scsh_prefresh); + S48_EXPORT_FUNCTION(scsh_pnoutrefresh); + S48_EXPORT_FUNCTION(scsh_pechochar); + + S48_EXPORT_FUNCTION(scsh_stdscr); + + S48_EXPORT_FUNCTION(scsh_LINES); + S48_EXPORT_FUNCTION(scsh_COLS); + + S48_EXPORT_FUNCTION(scsh_A_NORMAL); + S48_EXPORT_FUNCTION(scsh_A_STANDOUT); + S48_EXPORT_FUNCTION(scsh_A_UNDERLINE); + S48_EXPORT_FUNCTION(scsh_A_REVERSE); + S48_EXPORT_FUNCTION(scsh_A_BLINK); + S48_EXPORT_FUNCTION(scsh_A_DIM); + S48_EXPORT_FUNCTION(scsh_A_BOLD); + S48_EXPORT_FUNCTION(scsh_A_PROTECT); + S48_EXPORT_FUNCTION(scsh_A_INVIS); + S48_EXPORT_FUNCTION(scsh_A_ALTCHARSET); + + S48_EXPORT_FUNCTION(scsh_COLOR_BLACK); + S48_EXPORT_FUNCTION(scsh_COLOR_RED); + S48_EXPORT_FUNCTION(scsh_COLOR_GREEN); + S48_EXPORT_FUNCTION(scsh_COLOR_YELLOW); + S48_EXPORT_FUNCTION(scsh_COLOR_BLUE); + S48_EXPORT_FUNCTION(scsh_COLOR_MAGENTA); + S48_EXPORT_FUNCTION(scsh_COLOR_CYAN); + S48_EXPORT_FUNCTION(scsh_COLOR_WHITE); + + + S48_EXPORT_FUNCTION(scsh_wprintw); + S48_EXPORT_FUNCTION(scsh_printw); + S48_EXPORT_FUNCTION(scsh_refresh); + S48_EXPORT_FUNCTION(scsh_clear); + + + + +} diff --git a/scheme/ncurses-constants b/scheme/ncurses-constants new file mode 100644 index 0000000..4afe136 --- /dev/null +++ b/scheme/ncurses-constants @@ -0,0 +1,160 @@ +;;Konstanten. +//diese werden beim make durch die Konstanten aus curses.h expandiert. +//Dazu erfolgt der Aufruf des C-Pre-Prozessors folgendermaßen: +//cpp -P -imacros /usr/include/ncurses.h ncurses-constants.scm | +// sed -e '/^ *$/d' +// -e 's/refresh1/refresh/' -e 's/move1/move/' -e 's/clear1/clear/' +// > ncurses-constants.scm +//-P: +//keine linemarker erzeugen. +//-imacros file: +//es wird zuerst file eingelesen. Die Ausgabe wird weggeworfen. Es sind jetzt +//die Macros von dort verfügbar. +//sed: +//-e: Befehl ausführen (in diesem Fall reguläre Ausdrücke ersetzen) +//-^:Zeilenanfang +//- *:beliebig viele Leerzeichen +//$:Zeilenende +//d: löscht die Zeile +//s: reguläre Ausdrücke ersetzen + + +;Funktion um die Oktal-Zahlen aus der Headerdatei in scheme-integer +;zu konvertieren +(define make-oct-int + (lambda (i) + (string->number (string-append "#o" + (number->string i))))) +; +; +;;Farben +; +(define color-black COLOR_BLACK) +(define color-red COLOR_RED) +(define color-green COLOR_GREEN) +(define color-yellow COLOR_YELLOW) +(define color-blue COLOR_BLUE) +(define color-magenta COLOR_MAGENTA) +(define color-cyan COLOR_CYAN) +(define color-white COLOR_WHITE) + + +//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +//M-x replace-regexp +//#define KEY_\(.*\).*0[0-9][0-9][0-9].**/ +//(define key-\1 KEY_\1) + + +; +; +;;Sondertasten +; +(define key-code-yes (make-oct-int KEY_CODE_YES)) +(define key-min (make-oct-int KEY_MIN)) +(define key-break (make-oct-int KEY_BREAK)) +(define key-sreset (make-oct-int KEY_SRESET)) +(define key-reset (make-oct-int KEY_RESET)) +; +(define key-down (make-oct-int KEY_DOWN)) +(define key-up (make-oct-int KEY_UP)) +(define key-left (make-oct-int KEY_LEFT)) +(define key-right (make-oct-int KEY_RIGHT)) +(define key-home (make-oct-int KEY_HOME)) +(define key-backspace (make-oct-int KEY_BACKSPACE)) +(define key-f0 (make-oct-int KEY_F0)) +; +(define key-f1 (+ (make-oct-int KEY_F0) 1)) +(define key-f2 (+ (make-oct-int KEY_F0) 2)) +(define key-f3 (+ (make-oct-int KEY_F0) 3)) +(define key-f4 (+ (make-oct-int KEY_F0) 4)) +(define key-f5 (+ (make-oct-int KEY_F0) 5)) +(define key-f6 (+ (make-oct-int KEY_F0) 6)) +(define key-f7 (+ (make-oct-int KEY_F0) 7)) +(define key-f8 (+ (make-oct-int KEY_F0) 8)) +(define key-f9 (+ (make-oct-int KEY_F0) 9)) +(define key-f10 (+ (make-oct-int KEY_F0) 10)) +(define key-f11 (+ (make-oct-int KEY_F0) 11)) +(define key-f12 (+ (make-oct-int KEY_F0) 12)) +; +(define key-dl (make-oct-int KEY_DL)) +(define key-il (make-oct-int KEY_IL)) +(define key-dc (make-oct-int KEY_DC)) +(define key-ic (make-oct-int KEY_IC)) +(define key-eic (make-oct-int KEY_EIC)) +(define key-clear1 (make-oct-int KEY_CLEAR)) +(define key-eos (make-oct-int KEY_EOS)) +(define key-eol (make-oct-int KEY_EOL)) +(define key-sf (make-oct-int KEY_SF)) +(define key-sr (make-oct-int KEY_SR)) +(define key-npage (make-oct-int KEY_NPAGE)) +(define key-ppage (make-oct-int KEY_PPAGE)) +(define key-stab (make-oct-int KEY_STAB)) +(define key-ctab (make-oct-int KEY_CTAB)) +(define key-catab (make-oct-int KEY_CATAB)) +(define key-enter (make-oct-int KEY_ENTER)) +(define key-print (make-oct-int KEY_PRINT)) +(define key-ll (make-oct-int KEY_LL)) +(define key-a1 (make-oct-int KEY_A1)) +(define key-a3 (make-oct-int KEY_A3)) +(define key-b2 (make-oct-int KEY_B2)) +(define key-c1 (make-oct-int KEY_C1)) +(define key-c3 (make-oct-int KEY_C3)) +(define key-btab (make-oct-int KEY_BTAB)) +(define key-beg (make-oct-int KEY_BEG)) +(define key-cancel (make-oct-int KEY_CANCEL)) +(define key-close (make-oct-int KEY_CLOSE)) +(define key-command (make-oct-int KEY_COMMAND)) +(define key-copy (make-oct-int KEY_COPY)) +(define key-create (make-oct-int KEY_CREATE)) +(define key-end (make-oct-int KEY_END)) +(define key-exit (make-oct-int KEY_EXIT)) +(define key-find (make-oct-int KEY_FIND)) +(define key-help (make-oct-int KEY_HELP)) +(define key-mark (make-oct-int KEY_MARK)) +(define key-message (make-oct-int KEY_MESSAGE)) +(define key-move1 (make-oct-int KEY_MOVE)) +(define key-next (make-oct-int KEY_NEXT)) +(define key-open (make-oct-int KEY_OPEN)) +(define key-options (make-oct-int KEY_OPTIONS)) +(define key-previous (make-oct-int KEY_PREVIOUS)) +(define key-redo (make-oct-int KEY_REDO)) +(define key-reference (make-oct-int KEY_REFERENCE)) +(define key-refresh1 (make-oct-int KEY_REFRESH)) +(define key-replace (make-oct-int KEY_REPLACE)) +(define key-restart (make-oct-int KEY_RESTART)) +(define key-resume (make-oct-int KEY_RESUME)) +(define key-save (make-oct-int KEY_SAVE)) +(define key-sbeg (make-oct-int KEY_SBEG)) +(define key-scancel (make-oct-int KEY_SCANCEL)) +(define key-scommand (make-oct-int KEY_SCOMMAND)) +(define key-scopy (make-oct-int KEY_SCOPY)) +(define key-screate (make-oct-int KEY_SCREATE)) +(define key-sdc (make-oct-int KEY_SDC)) +(define key-sdl (make-oct-int KEY_SDL)) +(define key-select (make-oct-int KEY_SELECT)) +(define key-send (make-oct-int KEY_SEND)) +(define key-seol (make-oct-int KEY_SEOL)) +(define key-sexit (make-oct-int KEY_SEXIT)) +(define key-sfind (make-oct-int KEY_SFIND)) +(define key-shelp (make-oct-int KEY_SHELP)) +(define key-shome (make-oct-int KEY_SHOME)) +(define key-sic (make-oct-int KEY_SIC)) +(define key-sleft (make-oct-int KEY_SLEFT)) +(define key-smessage (make-oct-int KEY_SMESSAGE)) +(define key-smove (make-oct-int KEY_SMOVE)) +(define key-snext (make-oct-int KEY_SNEXT)) +(define key-soptions (make-oct-int KEY_SOPTIONS)) +(define key-sprevious (make-oct-int KEY_SPREVIOUS)) +(define key-sprint (make-oct-int KEY_SPRINT)) +(define key-sredo (make-oct-int KEY_SREDO)) +(define key-sreplace (make-oct-int KEY_SREPLACE)) +(define key-sright (make-oct-int KEY_SRIGHT)) +(define key-srsume (make-oct-int KEY_SRSUME)) +(define key-ssave (make-oct-int KEY_SSAVE)) +(define key-ssuspend (make-oct-int KEY_SSUSPEND)) +(define key-sundo (make-oct-int KEY_SUNDO)) +(define key-suspend (make-oct-int KEY_SUSPEND)) +(define key-undo (make-oct-int KEY_UNDO)) +(define key-mouse (make-oct-int KEY_MOUSE)) +(define key-resize (make-oct-int KEY_RESIZE)) +(define key-event (make-oct-int KEY_EVENT)) diff --git a/scheme/ncurses-constants.scm b/scheme/ncurses-constants.scm new file mode 100644 index 0000000..776f77b --- /dev/null +++ b/scheme/ncurses-constants.scm @@ -0,0 +1,132 @@ +;;Konstanten. +;Funktion um die Oktal-Zahlen aus der Headerdatei in scheme-integer +;zu konvertieren +(define make-oct-int + (lambda (i) + (string->number (string-append "#o" + (number->string i))))) +; +; +;;Farben +; +(define color-black 0) +(define color-red 1) +(define color-green 2) +(define color-yellow 3) +(define color-blue 4) +(define color-magenta 5) +(define color-cyan 6) +(define color-white 7) +; +; +;;Sondertasten +; +(define key-code-yes (make-oct-int 0400)) +(define key-min (make-oct-int 0401)) +(define key-break (make-oct-int 0401)) +(define key-sreset (make-oct-int 0530)) +(define key-reset (make-oct-int 0531)) +; +(define key-down (make-oct-int 0402)) +(define key-up (make-oct-int 0403)) +(define key-left (make-oct-int 0404)) +(define key-right (make-oct-int 0405)) +(define key-home (make-oct-int 0406)) +(define key-backspace (make-oct-int 0407)) +(define key-f0 (make-oct-int 0410)) +; +(define key-f1 (+ (make-oct-int 0410) 1)) +(define key-f2 (+ (make-oct-int 0410) 2)) +(define key-f3 (+ (make-oct-int 0410) 3)) +(define key-f4 (+ (make-oct-int 0410) 4)) +(define key-f5 (+ (make-oct-int 0410) 5)) +(define key-f6 (+ (make-oct-int 0410) 6)) +(define key-f7 (+ (make-oct-int 0410) 7)) +(define key-f8 (+ (make-oct-int 0410) 8)) +(define key-f9 (+ (make-oct-int 0410) 9)) +(define key-f10 (+ (make-oct-int 0410) 10)) +(define key-f11 (+ (make-oct-int 0410) 11)) +(define key-f12 (+ (make-oct-int 0410) 12)) +; +(define key-dl (make-oct-int 0510)) +(define key-il (make-oct-int 0511)) +(define key-dc (make-oct-int 0512)) +(define key-ic (make-oct-int 0513)) +(define key-eic (make-oct-int 0514)) +(define key-clear (make-oct-int 0515)) +(define key-eos (make-oct-int 0516)) +(define key-eol (make-oct-int 0517)) +(define key-sf (make-oct-int 0520)) +(define key-sr (make-oct-int 0521)) +(define key-npage (make-oct-int 0522)) +(define key-ppage (make-oct-int 0523)) +(define key-stab (make-oct-int 0524)) +(define key-ctab (make-oct-int 0525)) +(define key-catab (make-oct-int 0526)) +(define key-enter (make-oct-int 0527)) +(define key-print (make-oct-int 0532)) +(define key-ll (make-oct-int 0533)) +(define key-a1 (make-oct-int 0534)) +(define key-a3 (make-oct-int 0535)) +(define key-b2 (make-oct-int 0536)) +(define key-c1 (make-oct-int 0537)) +(define key-c3 (make-oct-int 0540)) +(define key-btab (make-oct-int 0541)) +(define key-beg (make-oct-int 0542)) +(define key-cancel (make-oct-int 0543)) +(define key-close (make-oct-int 0544)) +(define key-command (make-oct-int 0545)) +(define key-copy (make-oct-int 0546)) +(define key-create (make-oct-int 0547)) +(define key-end (make-oct-int 0550)) +(define key-exit (make-oct-int 0551)) +(define key-find (make-oct-int 0552)) +(define key-help (make-oct-int 0553)) +(define key-mark (make-oct-int 0554)) +(define key-message (make-oct-int 0555)) +(define key-move (make-oct-int 0556)) +(define key-next (make-oct-int 0557)) +(define key-open (make-oct-int 0560)) +(define key-options (make-oct-int 0561)) +(define key-previous (make-oct-int 0562)) +(define key-redo (make-oct-int 0563)) +(define key-reference (make-oct-int 0564)) +(define key-refresh (make-oct-int 0565)) +(define key-replace (make-oct-int 0566)) +(define key-restart (make-oct-int 0567)) +(define key-resume (make-oct-int 0570)) +(define key-save (make-oct-int 0571)) +(define key-sbeg (make-oct-int 0572)) +(define key-scancel (make-oct-int 0573)) +(define key-scommand (make-oct-int 0574)) +(define key-scopy (make-oct-int 0575)) +(define key-screate (make-oct-int 0576)) +(define key-sdc (make-oct-int 0577)) +(define key-sdl (make-oct-int 0600)) +(define key-select (make-oct-int 0601)) +(define key-send (make-oct-int 0602)) +(define key-seol (make-oct-int 0603)) +(define key-sexit (make-oct-int 0604)) +(define key-sfind (make-oct-int 0605)) +(define key-shelp (make-oct-int 0606)) +(define key-shome (make-oct-int 0607)) +(define key-sic (make-oct-int 0610)) +(define key-sleft (make-oct-int 0611)) +(define key-smessage (make-oct-int 0612)) +(define key-smove (make-oct-int 0613)) +(define key-snext (make-oct-int 0614)) +(define key-soptions (make-oct-int 0615)) +(define key-sprevious (make-oct-int 0616)) +(define key-sprint (make-oct-int 0617)) +(define key-sredo (make-oct-int 0620)) +(define key-sreplace (make-oct-int 0621)) +(define key-sright (make-oct-int 0622)) +(define key-srsume (make-oct-int 0623)) +(define key-ssave (make-oct-int 0624)) +(define key-ssuspend (make-oct-int 0625)) +(define key-sundo (make-oct-int 0626)) +(define key-suspend (make-oct-int 0627)) +(define key-undo (make-oct-int 0630)) +(define key-mouse (make-oct-int 0631)) +(define key-resize (make-oct-int 0632)) +(define key-event (make-oct-int 0633)) diff --git a/scheme/ncurses.scm b/scheme/ncurses.scm new file mode 100755 index 0000000..24c3318 --- /dev/null +++ b/scheme/ncurses.scm @@ -0,0 +1,1598 @@ + +;;record-types: +;;dienen dazu, C-Pointer zu verpacken. + +;;window +(define-record-type :window window + (make-window c-pointer) + window? + (c-pointer window-c-pointer)) + +;; screen +(define-record-type :screen screen + (make-screen c-pointer) + screen? + (c-pointer screen-c-pointer)) + +;;************************************************************************* + +;;Konstanten: + + +(define err -1) + + + + +;;Fehlerbehandlung: +;;Es kommt bei Funktionen mit Integer als Rückgabe im Fehlerfall +;;ERR zurück. Dann wird ein Fehler ausgelöst. Gleiches gilt, wenn +;;ein NULL-Pointer zurückkommt. + +(define-condition-type 'curses-error '(error)) + +(define curses-error? + (condition-predicate 'curses-error)) + + +;;OK ist 0 +;;Funktionen, die int nur zur Fehlerbehandlung zurueckgeben +(define (return-curses-code-int function-name code) + (if (zero? code) + (values) + (signal 'curses-error function-name))) + + +(define (raise-curses-error function-name) + (signal 'curses-error function-name)) + +(define (raise-curses-noinit-error) + (signal 'curses-error "use init-screen first")) + + +(define standard-screen) + +(import-lambda-definition set-stdscr-internal + () + "scsh_stdscr") + +(define set-standard-screen + (lambda () + (set! standard-screen (make-window (set-stdscr-internal))))) + +;;********************************************************************* +;;Bibliotheks-Funktionen +;;********************************************************************* + +;; ALLGEMEINE +;;Initialisierung +;;initscr liefert einen Zeiger auf stdscr +(import-lambda-definition init-screen-internal + () + "scsh_initscr") +(define init-screen + (lambda () + (define res (init-screen-internal)) + (begin (set-standard-screen) + (make-window (or res + (raise-curses-error "init-screen")))))) +;; (if ))) +;; (make-window +;; (or (init-screen-internal) +;; (raise-curses-error "init-screen"))))) + +(import-lambda-definition newterm-internal + (type outfd infd) + "scsh-newterm") +(define (newterm type outfd infd) + (make-screen (or (newterm-internal type + (port->fdes outfd) + (port->fdes infd)) + (raise-curses-error "newterm")))) + + +;;Beenden +(import-lambda-definition endwin + () + "scsh_endwin") + +(import-lambda-definition isendwin + () + "scsh_isendwin") + +(import-lambda-definition delscreen + () + "scsh_delscreen") + +;;Hilfsfunktionen +(import-lambda-definition unctrl-internal + (c) + "scsh_unctrl") +(define (unctrl c) + (or (unctrl-internal c) + (raise-curses-error "unctrl"))) + +(import-lambda-definition keyname-internal + (c) + "scsh_keyname") +(define (keyname c) + (or (keyname-internal c) + (raise-curses-error "keyname"))) + +(import-lambda-definition filter + () + "scsh_filter") + +(import-lambda-definition use_env + (f) + "scsh_use_env") + +(import-lambda-definition putwin-internal + (win file) + "scsh_putwin") +(define (putwin win file) + (return-curses-code-int "putwin" + (putwin-internal (window-c-pointer win) + (port->fdes file)))) + +(import-lambda-definition getwin-internal + (file) + "scsh_getwin") +(define (getwin file) + (make-window (or (getwin-internal (port->fdes file)) + (raise-curses-error "getwin")))) + +(import-lambda-definition delay-output-internal + (ms) + "scsh_delay_output") +(define (delay-output ms) + (return-curses-code-int "delay-output" + (delay-output-internal ms))) + +(import-lambda-definition flushinp-internal + () + "scsh_flushinp") +(define (flushinp) + (return-curses-code-int "flushinp" + (flushinp-internal))) + +(import-lambda-definition curses-version-internal + () + "scsh_curses_version") +(define (curses-version) + (or (curses-version-internal) + (raise-curses-error "curses-version"))) + +;;Einstellungen +(import-lambda-definition use-default-colors-internal + () + "scsh_use_default_colors") +(define (use-default-colors) + (return-curses-code-int "use-default-colors" + (use-default-colors-internal))) + +(import-lambda-definition assume-default-colors-internal + (fg bg) + "scsh_assume_default_colors") +(define (assume-default-colors fg bg) + (return-curses-code-int "assume-default-colors" + (assume-default-colors-internal fg bg))) + +(import-lambda-definition define-key-internal + (def keyc) + "scsh_define_key") +(define (define-key def keyc) + (return-curses-code-int "define-key" + (define-key-internal def keyc))) +;;************************************************************************* + +;;TERMINAL +;;Eigenschaften +(import-lambda-definition baudrate-internal + () + "scsh_baudrate") +(define (baudrate) + (or (baudrate-internal) + (raise-curses-error "bauderate"))) + +(import-lambda-definition erasechar + () + "scsh_erasechar") + +(import-lambda-definition has_ic + () + "scsh_has_ic") + +(import-lambda-definition has_il + () + "scsh_has_il") + +(import-lambda-definition killchar + () + "scsh_killchar") + +(import-lambda-definition longname-internal + () + "scsh_longname") +(define (longname) + (or (longname-internal) + (raise-curses-error "longname"))) + +(import-lambda-definition termname-internal + () + "scsh_termname") +(define (termname) + (or (termname-internal) + (raise-curses-error "termname"))) + +(import-lambda-definition has-key-internal + (ch) + "scsh_has_key") +(define (has-key ch) + (or (has-key-internal ch) + (raise-curses-error "has-key"))) + +;;Farbe +(import-lambda-definition start-color-internal + () + "scsh_start_color") +(define (start-color) + (return-curses-code-int "start-color" + (start-color-internal))) + +(import-lambda-definition init-pair-internal + (pair f b) + "scsh_init_pair") +(define (init-pair pair f b) + (return-curses-code-int "init-pair" + (init-pair-internal pair f b))) + + +(import-lambda-definition init-color-internal + (color r g b) + "scsh_init_color") +(define (init-color color r g b) + (return-curses-code-int "init-color" + (init-color-internal color r g b))) + +(import-lambda-definition has-colors + () + "scsh_has_colors") + +(import-lambda-definition can-change-colors + () + "scsh_can_change_colors") + +(import-lambda-definition color-pair + (num) + "scsh_color_pair") + + +;;Eingabe: +(import-lambda-definition cbreak-internal + () + "scsh_cbreak") +(define (cbreak) + (return-curses-code-int "cbreak" + (cbreak-internal))) + +(import-lambda-definition nocbreak-internal + () + "scsh_no_cbreak") +(define (nocbreak) + (return-curses-code-int "nocbreak" + (nocbreak-internal))) + +(import-lambda-definition echo-internal + () + "scsh_echo") +(define (echo) + (return-curses-code-int "echo" + (echo-internal))) + +(import-lambda-definition noecho-internal + () + "scsh_noecho") +(define (noecho) + (return-curses-code-int "noecho" + (noecho-internal))) + + +(import-lambda-definition halfdelay-internal + (tenth) + "scsh_halfdelay") +(define (halfdelay tenth) + (return-curses-code-int "halfdelay" + (halfdelay-internal tenth))) + +(import-lambda-definition intrflush-internal + (win bf) + "scsh_intrflush") +(define (intrflush win bf) + (return-curses-code-int "intrflush" + (intrflush-internal (window-c-pointer win) + bf))) + +(import-lambda-definition keypad-internal + (win bf) + "scsh_keypad") +(define (keypad win bf) + (return-curses-code-int "keypad" + (keypad-internal (window-c-pointer win) + bf))) + +(import-lambda-definition meta-internal + (win bf) + "scsh_meta") +(define (meta win bf) + (return-curses-code-int "meta" + (meta-internal (window-c-pointer win) + bf))) + +(import-lambda-definition nodelay-internal + (win bf) + "scsh_nodelay") +(define (nodelay win bf) + (return-curses-code-int "nodelay" + (nodelay-internal (window-c-pointer win) + bf))) + +(import-lambda-definition raw-internal + () + "scsh_raw") +(define (raw) + (return-curses-code-int "raw" + (raw-internal))) + +(import-lambda-definition noraw-internal + () + "scsh_noraw") +(define (noraw) + (return-curses-code-int "noraw" + (noraw-internal))) + +(import-lambda-definition qiflush + () + "scsh_qiflush") + +(import-lambda-definition noqiflush + () + "scsh_noqiflush") + +;;Terminalfunktionen +(import-lambda-definition beep-internal + () + "scsh_beep") +(define (beep) + (return-curses-code-int "beep" + (beep-internal))) + +(import-lambda-definition flash-internal + () + "scsh_flash") +(define (flash) + (return-curses-code-int "flash" + (flash-internal))) + +(import-lambda-definition def-prog-mode-internal + () + "scsh_def_prog_mode") +(define (def-prog-mode) + (return-curses-code-int "def-prog-mode" + (def-prog-mode-internal))) + +(import-lambda-definition def-shell-mode-internal + () + "scsh_def_shell_mode") +(define (def-shell-mode) + (return-curses-code-int "def-shell-mode" + (def-shell-mode-internal))) + + +(import-lambda-definition reset-prog-mode-internal + () + "scsh_reset_prog_mode") +(define (reset-prog-mode) + (return-curses-code-int "reset-prog-mode" + (reset-prog-mode-internal))) + +(import-lambda-definition reset-shell-mode-internal + () + "scsh_reset_shell_mode") +(define (reset-shell-mode) + (return-curses-code-int "reset-shell-mode" + (reset-shell-mode-internal))) + +(import-lambda-definition resetty-internal + () + "scsh_resetty") +(define (resetty) + (return-curses-code-int "resetty" + (resetty))) + +(import-lambda-definition savetty-internal + () + "scsh_savetty") +(define (savetty) + (return-curses-code-int "savetty" + (savetty))) + +(import-lambda-definition curs-set-internal + (visibility) + "scsh_curs_set") +(define (curs-set visibility) + (return-curses-code-int "curs-set" + (curs-set-internal visibility))) + + +(import-lambda-definition napms-internal + (ms) + "scsh_napms") +(define (napms ms) + (return-curses-code-int "napms" + (napms-internal ms))) + +(import-lambda-definition mcprint-internal + (data len) + "scsh_mcprint") +(define (mcprint data len) + (return-curses-code-int "mcprint" + (mcprint-internal data len))) + +(import-lambda-definition is-term-resized + (lines columns) + "scsh_is_term_resized") + +(import-lambda-definition resize-term-internal + (lines columns) + "scsh_resize_term") +(define (resize-term lines columns) + (return-curses-code-int "resize-term" + (resize-term-internal lines columns))) + +(import-lambda-definition resizeterm-internal + (lines columns) + "scsh_resizeterm") +(define (resizeterm lines columns) + (return-curses-code-int "resizeterm" + (resizeterm-internal lines columns))) + +(import-lambda-definition scr-dump-internal + (filename) + "scsh_scr_dump") +(define (scr-dump filename) + (return-curses-code-int "scr-dump" + (scr-dump-internal filename))) + +(import-lambda-definition scr-restore-internal + (filename) + "scsh_scr_restore") +(define (scr-restore filename) + (return-curses-code-int "scr-restore" + (scr-restore-internal filename))) + +(import-lambda-definition scr-init-internal + (filename) + "scsh_scr_init") +(define (scr-init filename) + (return-curses-code-int "scr-init" + (scr-init-internal filename))) + +(import-lambda-definition scr-set-internal + (filename) + "scsh_scr_set") +(define (scr-set filename) + (return-curses-code-int "scr-set" + (scr-set-internal filename))) + + + +;;mehrere Terminals: +(import-lambda-definition set-term-internal + (new) + "scsh_set_term") +(define (set-term new) + (make-screen (or (set-term-internal (screen-c-pointer new)) + (raise-curses-error "set-term")))) + +;;************************************************************************* + +;;FENSTER + +;;Allgemeine +(import-lambda-definition newwin-internal + (height width starty startx) + "scsh_newwin") +(define (newwin h w x y) + (make-window (or (newwin-internal h w x y) + (raise-curses-error "newwin")))) + + +(import-lambda-definition delwin-internal + (win) + "scsh_delwin") +(define (delwin win) + (return-curses-code-int "delwin" + (delwin-internal (window-c-pointer win)))) + +(import-lambda-definition mvwin-internal + (win y x) + "scsh_mvwin") +(define (mvwin win y x) + (return-curses-code-int "mvwin" + (mvwin-internal (window-c-pointer win) y x))) + +(import-lambda-definition subwin-internal + (orig nlines ncols begin_y begin_x) + "scsh_subwin") +(define (subwin orig nlines ncols begin_y begin_x) + (make-window (or (subwin-internal (window-c-pointer orig) + nlines ncols begin_y begin_x) + (raise-curses-error "subwin")))) + +(import-lambda-definition derwin-internal + (orig nlines ncols begin_y begin_x) + "scsh_derwin") +(define (derwin orig nlines ncols begin_y begin_x) + (make-window (or (derwin-internal (window-c-pointer orig) + nlines ncols begin_y begin_x) + (raise-curses-error "derwin")))) + +(import-lambda-definition mvderwin-internal + (win par_y par_x) + "scsh_mvderwin") +(define (mvderwin win par_y par_x) + (return-curses-code-int + "mvderwin" + (mvderwin-internal (window-c-pointer win) par_y par_x))) + +(import-lambda-definition dupwin-internal + (win) + "scsh_dupwin") +(define (dupwin win) + (make-window (or (dupwin-internal (window-c-pointer win)) + (raise-curses-error "dupwin")))) + +(import-lambda-definition wsyncup-internal + (win) + "scsh_wsyncup") +(define (wsyncup win) + (or (wsyncup-internal (window-c-pointer win)) + (raise-curses-error "wsyncup"))) + +(import-lambda-definition wcursyncup-internal + (win) + "scsh_wcursyncup") +(define (wcursyncup win) + (or (wcursyncup-internal (window-c-pointer win)) + (raise-curses-error "wcursyncup"))) + +(import-lambda-definition wsyncdown-internal + (win) + "scsh_wsyncdown") +(define (wsyncdown win) + (or (wsyncdown-internal (window-c-pointer win)) + (raise-curses-error "wsyncdown"))) + +(import-lambda-definition syncok-internal + (win bf) + "scsh_syncok") +(define (syncok win bf) + (return-curses-code-int + "syncok" + (syncok-internal (window-c-pointer win) bf))) + +(import-lambda-definition wrefresh-internal + (win) + "scsh_wrefresh") +(define (wrefresh win) + (return-curses-code-int + "wrefresh" + (wrefresh-internal (window-c-pointer win)))) + +(import-lambda-definition wnoutrefresh-internal + (win) + "scsh_wnoutrefresh") +(define (wnoutrefresh win) + (return-curses-code-int + "wnoutrefresh" + (wnoutrefresh-internal (window-c-pointer win)))) + +(import-lambda-definition redrawwin-internal + (win) + "scsh_redrawwin") +(define (redrawwin win) + (return-curses-code-int + "redrawwin" + (redrawwin-internal (window-c-pointer win)))) + +(import-lambda-definition doupdate-internal + () + "scsh_doupdate") +(define (doupdate) + (return-curses-code-int + "doupdate" + (doupdate-internal ))) + +(import-lambda-definition wredrawln-internal + (win beg_line num_lines) + "scsh_wredrawln") +(define (wredrawln win beg_line num_lines) + (return-curses-code-int + "wredrawln" + (wredrawln-internal (window-c-pointer win) beg_line num_lines))) + +;;(import-lambda-definition getyx-internal +;; (win) +;; "scsh_getyx") +;;(define (getyx win) +;; (getyx_internal (window-c-pointer win))) + +;;(import-lambda-definition getparyx-internal +;; (win y x) +;; "scsh_getparyx") +;;(define (getparyx win y x) +;; (getparyx_internal (window-c-pointer win) y x)) + +;;(import-lambda-definition getbegyx-internal +;; (win y x) +;; "scsh_getbegyx") +;;(define (getbegyx win y x) +;; (getbegyx_internal (window-c-pointer win) y x)) + +;;(import-lambda-definition getmaxyx-internal +;; (win y x) +;; "scsh_getmaxyx") +;;(define (getmaxyx win y x) +;; (getmaxyx_internal (window-c-pointer win) y x)) + +(import-lambda-definition wresize-internal + (win lines columns) + "scsh_wresize") +(define (wresize win lines columns) + (return-curses-code-int + "wresize" + (wresize-internal (window-c-pointer win) lines columns))) + + +;;Ausgabe-Einstellungen + +(import-lambda-definition idlok-internal + (win bf) + "scsh_idlok") +(define (idlok win bf) + (return-curses-code-int + "idlok" + (idlok-internal (window-c-pointer win) bf))) + +(import-lambda-definition leaveok-internal + (win bf) + "scsh_leaveok") +(define (leaveok win bf) + (return-curses-code-int + "leaveok" + (leaveok-internal (window-c-pointer win) bf))) + +(import-lambda-definition scrollok-internal + (win bf) + "scsh_scrollok") +(define (scrollok win bf) + (return-curses-code-int + "scrollok" + (scrollok-internal (window-c-pointer win) bf))) + +(import-lambda-definition idcok-internal + (win bf) + "scsh_idcok") +(define (idcok win bf) + (idcok-internal (window-c-pointer win) bf)) + +(import-lambda-definition immedok-internal + (win bf) + "scsh_immedok") +(define (immedok win bf) + (immedok-internal (window-c-pointer win) bf)) + +(import-lambda-definition wsetscrreg-internal + (win top bot) + "scsh_wsetscrreg") +(define (wsetscrreg win top bot) + (return-curses-code-int + "wsetscrreg" + (wsetscrreg-internal (window-c-pointer win) top bot))) + +(import-lambda-definition nl-internal + () + "scsh_nl") +(define (nl) + (return-curses-code-int + "nl" + (nl-internal))) + +(import-lambda-definition nonl-internal + () + "scsh_nonl") +(define (nonl) + (return-curses-code-int + "nonl" + (nonl-internal))) + +;;Text anzeigen + +(import-lambda-definition waddch-internal + (win ch) + "scsh_waddch") +(define (waddch win ch) + (return-curses-code-int + "waddch" + (waddch-internal (window-c-pointer win) ch))) + +(import-lambda-definition wechochar-internal + (win ch) + "scsh_wechochar") +(define (wechochar win ch) + (return-curses-code-int + "wechochar" + (wechochar-internal (window-c-pointer win) ch))) + +(import-lambda-definition waddstr-internal + (win str) + "scsh_waddstr") +(define (waddstr win str) + (return-curses-code-int + "waddstr" + (waddstr-internal (window-c-pointer win) str))) + +(import-lambda-definition waddnstr-internal + (win str n) + "scsh_waddnstr") +(define (waddnstr win str n) + (return-curses-code-int + "waddnstr" + (waddnstr-internal (window-c-pointer win) str n))) + +(import-lambda-definition winsch-internal + (win ch) + "scsh_winsch") +(define (winsch win ch) + (return-curses-code-int + "winsch" + (winsch-internal (window-c-pointer win) ch))) + +(import-lambda-definition winsstr-internal + (win str) + "scsh_winsstr") +(define (winsstr win str) + (return-curses-code-int + "winsstr" + (winsstr-internal (window-c-pointer win) str))) + +(import-lambda-definition winsnstr-internal + (win str n) + "scsh_winsnstr") +(define (winsnstr win str n) + (return-curses-code-int + "winsnstr" + (winsnstr-internal (window-c-pointer win) str n))) + + +;;Attribute +(import-lambda-definition wattroff-internal + (win attrs) + "scsh_wattroff") +(define (wattroff win attrs) + (return-curses-code-int + "wattroff" + (wattroff-internal (window-c-pointer win) attrs))) + +(import-lambda-definition wattron-internal + (win attrs) + "scsh_wattron") +(define (wattron win attrs) + (return-curses-code-int + "wattron" + (wattron-internal (window-c-pointer win) attrs))) + +(import-lambda-definition wattrset-internal + (win attrs) + "scsh_wattrset") +(define (wattrset win attrs) + (return-curses-code-int + "wattrset" + (wattrset-internal (window-c-pointer win) attrs))) + +(import-lambda-definition wstandend-internal + (win) + "scsh_wstandend") +(define (wstandend win) + (return-curses-code-int + "wstandend" + (wstandend-internal (window-c-pointer win)))) + +(import-lambda-definition wstandout-internal + (win) + "scsh_wstandout") +(define (wstandout win) + (return-curses-code-int + "wstandout" + (wstandout-internal (window-c-pointer win)))) + + +;;Background: + +(import-lambda-definition wbkgdset-internal + (win ch) + "scsh_wbkgdset") +(define (wbkgdset win ch) + (wbkgdset-internal (window-c-pointer win) ch)) + +(import-lambda-definition wbkgd-internal + (win ch) + "scsh_wbkgd") +(define (wbkgd win ch) + (return-curses-code-int + "wbkgd" + (wbkgd-internal (window-c-pointer win) ch))) + +(import-lambda-definition getbkgd-internal + (win) + "scsh_getbkgd") +(define (getbkgd win) + (getbkgd-internal (window-c-pointer win))) + + +;;Umrandung des Fensters: + +(import-lambda-definition wborder-internal + (win ls rs ts bs tl tr bl br) + "scsh_wborder") +(define (wborder win ls rs ts bs tl tr bl br) + (return-curses-code-int + "wboredr" + (wborder-internal (window-c-pointer win) ls rs ts bs tl tr bl br))) + +(import-lambda-definition box-internal + (win verch horch) + "scsh_box") +(define (box win verch horch) + (return-curses-code-int + "box" + (box-internal + (window-c-pointer win) verch horch))) + +(import-lambda-definition whline-internal + (win ch n) + "scsh_whline") +(define (whline win ch n) + (return-curses-code-int + "whline" + (whline-internal + (window-c-pointer win) ch n))) + +(import-lambda-definition wvline-internal + (win ch n) + "scsh_wvline") +(define (wvline win ch n) + (return-curses-code-int + "wvline" + (wvline-internal + (window-c-pointer win) ch n))) + + +;;Cursor + +(import-lambda-definition scroll-internal + (win) + "scsh_scroll") +(define (scroll win) + (return-curses-code-int + "scroll" + (scroll-internal + (window-c-pointer win)))) + +(import-lambda-definition wscl-internal + (win n) + "scsh_wscrl") +(define (wscrl win n) + (return-curses-code-int + "wscrl" + (wscl-internal + (window-c-pointer win) n))) + +(import-lambda-definition wmove-internal + (win y x) + "scsh_wmove") +(define (wmove win y x) + (return-curses-code-int + "wmove" + (wmove-internal + (window-c-pointer win) y x))) + + +;;Eingabe + +(import-lambda-definition wgetch-internal + (win) + "scsh_wgetch") +(define (wgetch win) + (nodelay win #t) + (let ((ch (wgetch-internal (window-c-pointer win)))) + (if (not (= err ch)) + ch + (begin + (select-port-channels #f (current-input-port)) + (nodelay win #f) + (wgetch-internal (window-c-pointer win)))))) + + +(define (wgetstr win) + (let loop ((str "")) + (keypad win #t) + (let ((ch (wgetch win))) + (cond + ;;newline + ((= ch 10)(begin + (keypad win #f) + str)) + ;;backspace + ((= ch key-backspace) + (if (= (string-length str) 0) + (loop str) + (begin + ;;letztes Zeichen löschen + (backspace win) + (loop (substring str 0 (- (string-length str) 1)))))) + ;;sonst + (else + (if (> ch 255) + (loop str) + (loop (string-append str (string (ascii->char ch)))))))))) + +(define (wgetnstr win n) + (let loop ((str "") (count 0)) + (keypad win #t) + (if (<= n 0) + ;;Spezialfall n<=0 -> nur echo ausschalten und "" zurueckgeben + (begin (noecho) + (let ((ch (ascii->char(wgetch win)))) + (if (equal? #\newline ch) + ;;Rückkehr + (begin (echo) + (keypad win #f) + str) + ;;warten auf newline + (loop str count)))) + ;;n>0 -> n Zeichen lesen (oder newline), dann noecho + (let ((ch (wgetch win))) + (cond + ;;newline -> Rückkehr + ((= ch 10) (begin (echo) + (keypad win #f) + str)) + ;;backspace + ((= ch key-backspace) + (if (= count 0) + (loop "" count) + (if (= count n ) + (begin + (echo) + (back win) + (wdelch win) + (wrefresh win) + (loop (substring str 0 (- count 1)) (- count 1 ))) + (begin + (backspace win) + (loop (substring str 0 (- count 1)) (- count 1)))))) + ;;sonst + (else (if (or (>= count n) (> ch 255)) + (loop str count) + (let ((newstr (string-append str + (string (ascii->char ch))))) + (if (= count (- n 1)) + (begin + (noecho) (loop newstr (+ count 1))) + (loop newstr (+ count 1))))))))))) + + +;; (if (>= count n ) +;; ;; wenn newline kommt->fertig, sonst ignorieren +;; (if (equal? #\newline ch) +;; (begin +;; (echo) +;; str) +;; (loop str count)) +;; ;; wenn newline kommt->fertig, sonst anhaengen +;; (let ((newstr (string-append str (string ch)))) +;; (if (equal? #\newline ch) +;; str + ;; ab dem n-ten Zeichen wird die Eingabe nicht "geechot" +;; (if (= count (- n 1)) +;; (begin +;; (noecho) +;; (loop newstr (+ count 1))) +;; (loop newstr (+ count 1)))))))))) + + + +(import-lambda-definition winch-internal + (win) + "scsh_winch") +(define (winch win) + (winch-internal (window-c-pointer win))) + +(import-lambda-definition winstr-internal + (win) + "scsh_winstr") +(define (winstr win) + (or (winstr-internal (window-c-pointer win)) + (raise-curses-error "winstr"))) + +(import-lambda-definition winnstr-internal + (win) + "scsh_winnstr") +(define (winnstr win n) + (or (winnstr-internal (window-c-pointer win) n) + (raise-curses-error "winnstr"))) + + + + +;;Loeschen + +(import-lambda-definition werase-internal + (win) + "scsh_werase") +(define (werase win) + (return-curses-code-int + "werase" + (werase-internal + (window-c-pointer win)))) + +(import-lambda-definition wclear-internal + (win) + "scsh_wclear") +(define (wclear win) + (return-curses-code-int + "wclear" + (wclear-internal + (window-c-pointer win)))) + +(import-lambda-definition wclrtobot-internal + (win) + "scsh_wclrtobot") +(define (wclrtobot win) + (return-curses-code-int + "wclrtobot" + (wclrtobot-internal + (window-c-pointer win)))) + +(import-lambda-definition wclrtoeol-internal + (win) + "scsh_wclrtoeol") +(define (wclrtoeol win) + (return-curses-code-int + "wclrtoeol" + (wclrtoeol-internal + (window-c-pointer win)))) + +(import-lambda-definition clearok-internal + (win bf) + "scsh_clearok") +(define (clearok win bf) + (return-curses-code-int + "clearok" + (clearok-internal + (window-c-pointer win) bf))) + +(import-lambda-definition wdelch-internal + (win) + "scsh_wdelch") +(define (wdelch win) + (return-curses-code-int + "wdelch" + (wdelch-internal + (window-c-pointer win)))) + + +(import-lambda-definition wdeleteln-internal + (win) + "scsh_wdeleteln") +(define (wdeleteln win) + (return-curses-code-int + "wdeleteln" + (wdeleteln-internal + (window-c-pointer win)))) + + +(import-lambda-definition winsertln-internal + (win) + "scsh_winsertln") +(define (winsertln win) + (return-curses-code-int + "winsertln" + (winsertln-internal + (window-c-pointer win)))) + +(import-lambda-definition winsdelln-internal + (win n) + "scsh_winsdelln") +(define (winsdelln win n) + (return-curses-code-int + "winsdelln" + (winsdelln-internal + (window-c-pointer win) n))) + + +;;mehrere Fenster + +(import-lambda-definition overlay-internal + (srcwin dstwin) + "scsh_overlay") +(define (overlay srcwin dstwin) + (return-curses-code-int + "overlay" + (overlay-internal + (window-c-pointer srcwin) (window-c-pointer dstwin)))) + +(import-lambda-definition overwrite-internal + (srcwin dstwin) + "scsh_overwrite") +(define (overwrite srcwin dstwin) + (return-curses-code-int + "overwrite" + (overwrite-internal + (window-c-pointer srcwin) (window-c-pointer dstwin)))) + + +(import-lambda-definition copywin-internal + (srcwin dstwin sminrow smincol dminrow dmincol dmaxrow dmaxcol overlay) + "scsh_copywin") +(define (copywin srcwin dstwin sminrow smincol dminrow dmincol dmaxrow + dmaxcol overlay) + (return-curses-code-int + "copywin" + (copywin-internal + (window-c-pointer srcwin) (window-c-pointer dstwin) + sminrow smincol dminrow dmincol dmaxrow dmaxcol overlay))) + + +;;Eigenschaften + +(import-lambda-definition touchline-internal + (win start count) + "scsh_touchline") +(define (touchline win start count) + (return-curses-code-int + "touchline" + (touchline-internal (window-c-pointer win) start count))) + +(import-lambda-definition touchwin-internal + (win) + "scsh_touchwin") +(define (touchwin win) + (return-curses-code-int + "touchwin" + (touchwin-internal (window-c-pointer win)))) + +(import-lambda-definition untouchwin-internal + (win) + "scsh_untouchwin") +(define (untouchwin win) + (return-curses-code-int + "untouchwin" + (untouchwin-internal (window-c-pointer win)))) + +(import-lambda-definition wtouchln-internal + (win y n changed) + "scsh_wtouchln") +(define (wtouchln win y n changed) + (return-curses-code-int + "wtouchln" + (wtouchln-internal (window-c-pointer win) y n changed))) + +(import-lambda-definition is-linetouched-internal + (win line) + "scsh_is_linetouched") +(define (is-linetouched win line) + (is-linetouched-internal (window-c-pointer win) line)) + +(import-lambda-definition is-wintouched-internal + (win) + "scsh_is_wintouched") +(define (is-wintouched win) + (is-wintouched-internal (window-c-pointer win))) + +;;************************************************************************* + +;;PADS + +(import-lambda-definition newpad-internal + (nlines ncols) + "scsh_newpad") +(define (newpad nlines ncols) + (make-window (or (newpad-internal nlines ncols) + (raise-curses-error "newpad")))) + +(import-lambda-definition subpad-internal + (orig nlines ncols begin_y begin_x) + "scsh_subpad") +(define (subpad orig nlines ncols begin_y begin_x) + (make-window (or (subpad-internal + (window-c-pointer orig) + nlines ncols begin_y begin_x) + (raise-curses-error "newpad")))) + +(import-lambda-definition prefresh-internal + (pad pminrow pmincol sminrow smincol smaxrow smaxcol) + "scsh_prefresh") +(define (prefresh pad pminrow pmincol sminrow smincol smaxrow smaxcol ) + (return-curses-code-int + "prefresh" + (prefresh-internal + (window-c-pointer pad) pminrow pmincol sminrow smincol smaxrow smaxcol))) + +(import-lambda-definition pnoutrefresh-internal + (pad pminrow pmincol sminrow smincol smaxrow smaxcol) + "scsh_pnoutrefresh") +(define (pnoutrefresh pad pminrow pmincol sminrow smincol smaxrow smaxcol ) + (return-curses-code-int + "pnoutrefresh" + (pnoutrefresh-internal + (window-c-pointer pad) pminrow pmincol sminrow smincol smaxrow smaxcol))) + +(import-lambda-definition pechochar-internal + (pad ch) + "scsh_pechochar") +(define (pechochar pad ch) + (return-curses-code-int + "pechochar" + (pechochar-internal (window-c-pointer pad) ch))) + +;;************************************************************************* + +;;KONSTANTEN + +;;Standardscreen (s.o.) + +;;Lines/Cols +(import-lambda-definition COLS + () + "scsh_COLS") + +(import-lambda-definition LINES + () + "scsh_LINES") + + +;;Attribute +(import-lambda-definition A-NORMAL + () + "scsh_A_NORMAL") + +(import-lambda-definition A-STANDOUT + () + "scsh_A_STANDOUT") + +(import-lambda-definition A-UNDERLINE + () + "scsh_A_UNDERLINE") + +(import-lambda-definition A-REVERSE + () + "scsh_A_REVERSE") + +(import-lambda-definition A-BLINK + () + "scsh_A_BLINK") + +(import-lambda-definition A-DIM + () + "scsh_A_DIM") + +(import-lambda-definition A-BOLD + () + "scsh_A_BOLD") + +(import-lambda-definition A-PROTECT + () + "scsh_A_PROTECT") + +(import-lambda-definition A-INVIS + () + "scsh_A_INVIS") + +(import-lambda-definition A-ALTCHARSET + () + "scsh_A_ALTCHARSET") + +(import-lambda-definition COLOR-BLACK + () + "scsh_COLOR_BLACK") + +(import-lambda-definition COLOR-RED + () + "scsh_COLOR_RED") + +(import-lambda-definition COLOR-GREEN + () + "scsh_COLOR_GREEN") + +(import-lambda-definition COLOR-YELLOW + () + "scsh_COLOR_YELLOW") + +(import-lambda-definition COLOR-BLUE + () + "scsh_COLOR_BLUE") + +(import-lambda-definition COLOR-MAGENTA + () + "scsh_COLOR_MAGENTA") + +(import-lambda-definition COLOR-CYAN + () + "scsh_COLOR_CYAN") + +(import-lambda-definition COLOR-WHITE + () + "scsh_COLOR_WHITE") + +(import-lambda-definition wprintw-internal + (win str) + "scsh_wprintw") +(define (wprintw win str) + (return-curses-code-int + "wprintw" + (wprintw-internal (window-c-pointer win) str))) + + + +;;************************************************************************* + +;;STDSCR-FUNKTIONEN +;;diese werden auf scheme-seite neu definiert, um moeglichst viel +;;komplexitaet auf dieser seite zu halten. + +(define (refresh) + (wrefresh standard-screen)) + +(define (move y x) + (wmove standard-screen y x)) + +(define (setscrreg top bot) + (wsetscrreg standard-screen top bot)) + +(define (scrl n) + (wscrl standard-screen n)) + +(define (addch ch) + (waddch standard-screen ch)) + +(define (echochar ch) + (wechochar standard-screen ch)) + +(define (addstr str) + (waddstr standard-screen str)) + +(define (addnstr str n) + (waddnstr standard-screen str n)) + +(define (insch ch) + (winsch standard-screen ch)) + +(define (insstr str) + (winsstr standard-screen str)) + +(define (insnstr str n) + (winsnstr standard-screen str n)) + +(define (printw str) + (wprintw standard-screen str)) + + +(define (attroff attrs) + (wattroff standard-screen attrs)) + +(define (attron attrs) + (wattron standard-screen attrs)) + +(define (attrset attrs) + (wattrset standard-screen attrs)) + +(define (standend) + (wstandend standard-screen)) + +(define (standout) + (wstandout standard-screen)) + +(define (bkgdset ch) + (wbkgdset standard-screen ch)) + +(define (bkgd ch) + (wbkgd standard-screen ch)) + +(define (border ls rs ts bs tl tr bl br) + (wborder standard-screen ls rs ts bs tl tr bl br)) + +(define (hline ch n) + (whline standard-screen ch n)) + +(define (vline ch n) + (wvline standard-screen ch n)) + +(define (getch) + (wgetch standard-screen)) + +(define (getstr) + (wgetstr standard-screen)) + +(define (getnstr n) + (wgetnstr standard-screen n)) + + +(define (erase) + (werase standard-screen )) + +(define (clear) + (wclear standard-screen)) + +(define (clrtobot) + (wclrtobot standard-screen)) + +(define (clrtoeol) + (wclrtoeol standard-screen)) + +(define (delch) + (wdelch standard-screen)) + +(define (deleteln) + (wdeleteln standard-screen)) + +(define (insdelln n) + (winsdelln standard-screen n)) + +(define (insertln) + (winsertln standard-screen)) + + +;;************************************************************************* + +;;"MVW"-Funktionen. +;;bewegen den Cursor im uebergebenen Fenster und fuehren die entsprechende +;;Aktion aus. Auch sie sind nur in scheme implementiert. + +(define (mvwaddch win y x ch) + (begin (wmove win y x) + (waddch win ch))) + +(define (mvwaddstr win y x str) + (begin (wmove win y x) + (waddstr win str))) + +(define (mvwaddnstr win y x str n) + (begin (wmove win y x) + (waddnstr win str n))) + +(define (mvwinsch win y x ch) + (begin (wmove win y x) + (winsch win ch))) + +(define (mvwinsstr win y x str) + (begin (wmove win y x) + (winsstr win str))) + +(define (mvwinsnstr win y x str n) + (begin (wmove win y x) + (winsnstr win str n))) + +(define (mvwprintw win y x str) + (begin (wmove win y x) + (wprintw win str))) + + +(define (mvwhline win y x ch n) + (begin (wmove win y x) + (whline win ch n))) + +(define (mvwvline win y x ch n) + (begin (wmove win y x) + (wvline win ch n))) + +(define (mvwgetch win y x) + (begin (wmove win y x) + (wgetch win ))) + +(define (mvwgetstr win y x) + (begin (wmove win y x) + (wgetstr win ))) + +(define (mvwgetnstr win y x n) + (begin (wmove win y x) + (wgetnstr win n))) + + +(define (mvwdelch win y x) + (begin (wmove win y x) + (wdelch win))) + +;;********************************************************************* + +;;zusätzliche Funktionen + + +;;Cursor-Positionen +(import-lambda-definition gety-internal + (win) + "scsh_gety") +(define gety + (lambda(win) + (gety-internal (window-c-pointer win)))) + +(import-lambda-definition getx-internal + (win) + "scsh_getx") +(define getx + (lambda (win) + (getx-internal (window-c-pointer win)))) + +;;Fenstergröße +(import-lambda-definition getmaxy-internal + (win) + "scsh_getmaxy") +(define getmaxy + (lambda (win) + (getmaxy-internal (window-c-pointer win)))) + +(import-lambda-definition getmaxx-internal + (win) + "scsh_getmaxx") +(define getmaxx + (lambda (win) + (getmaxx-internal (window-c-pointer win)))) + + +;;eine Position zurueck + +(define backspace + (lambda (win) + (let ((y (gety win)) + (x (getx win)) + (cols (getmaxx win))) + (if (and (= 0 y) (= 0 x)) + (if (equal? #\space (winch win)) + values + (begin + (wdelch win) + (wrefresh win))) + (if (= 0 x) + (begin + (wmove win y 0) + (wrefresh win) + (if (equal? #\space (winch win)) + (begin + (wmove win (- y 1) (- cols 1)) + (wdelch win) + (wrefresh win)) + (begin + (wdelch win) + (wrefresh win)))) + (begin + (wdelch win) + (wrefresh win))))))) + +(define back + (lambda (win) + (let ((y (gety win)) + (x (getx win)) + (cols (getmaxx win))) + (if (and (= 0 y) (= 0 x)) + values + (if (= 0 x) + (begin + (wmove win (- y 1) (- cols 1)) + (wrefresh win)) + (begin + (wmove win y (- x 1)) + (wrefresh win))))))) + + \ No newline at end of file diff --git a/scheme/scsh-package.scm b/scheme/scsh-package.scm new file mode 100644 index 0000000..6cf9dcd --- /dev/null +++ b/scheme/scsh-package.scm @@ -0,0 +1,958 @@ +;;; The packages that scsh uses/defines. +;;; Copyright (c) 1994 by Olin Shivers. + +;;; Note: field-reader package (fr.scm) and here docs use READ-LINE. +;;; It is defined in rdelim.scm. + +;;; You link up a scsh package by defining a package named OS-DEPENDENT +;;; that satisfies the interfaces for packages +;;; buffered-io-flags +;;; posix-fdflags +;;; posix-errno +;;; posix-signals +;;; Anything else it provides should be specified in an interface called +;;; os-extras-interface. See the scsh structure below. +;;; Then the scsh structure can be instantiated. +;;; +;;; The architecture directories, like next/ and irix/ and so forth, +;;; provide packages that can serve as the os-dependent package. E.g., +;;; the next-defs package, defined in next/packages. +;;; +;;; This whole mechanism would be better solved with a functor. +;;; -Olin + + +;;; The LET-OPT package for optional argument parsing & defaulting +;;; is found in the let-opt.scm file. + + +(define-structure error-package (export error warn) + (open signals) +; (optimize auto-integrate) + ) + + +(define-structure scsh-utilities scsh-utilities-interface + (open bitwise error-package loopholes let-opt scheme define-record-types + records + threads threads-internal placeholders locks srfi-1) + (files utilities) +; (optimize auto-integrate) + ) + +(define-structure weak-tables weak-tables-interface + (open scheme + weak + tables) + (files weaktables)) + +(define-structure string-collectors string-collectors-interface + (open scheme + defrec-package) + (files stringcoll)) + +(define-structure delimited-readers delimited-readers-interface + (open scheme + byte-vectors + signals ; ERROR + let-opt + receiving + re-level-0 rx-syntax + (subset srfi-14 (char-set x->char-set char-set-contains?)) + ascii + i/o-internal ports) + (files rdelim)) + +(define list-lib srfi-1) +(define string-lib srfi-13) +(define char-set-lib srfi-14) + + +;;; This guy goes into the FOR-SYNTAX part of scsh's syntax exports. +(define-structure scsh-syntax-helpers + (export transcribe-extended-process-form) + (open receiving ; receive + error-package + names ; generated? by JMG + scsh-utilities ; check-arg + scheme + ) + (files syntax-helpers) +; (optimize auto-integrate) + ) + + +;;; The bufpol/{block, line, none} values +(define-structure buffered-io-flags buffered-io-flags-interface + (open defenum-package scheme) + (files (machine bufpol)) +; (optimize auto-integrate) + ) + + + +(define-structures ((tty-flags tty-flags-interface) + (scsh-internal-tty-flags scsh-internal-tty-flags-interface)) + (open scheme ascii bitwise) + (files (machine tty-consts)) +; (optimize auto-integrate) + ) + + +(define-structure scsh-version scsh-version-interface + (open scheme) + (files scsh-version)) + +(define-structure scsh-endian scsh-endian-interface + (open scheme + bitwise) + (files endian)) + +;;; The scsh-level-0 package is for implementation convenience. +;;; The scsh startup and top-level modules need access to scsh +;;; procedures, but they export procedures that are themselves +;;; part of scsh. So scsh-level-0 is the core scsh stuff, which is +;;; imported by these two modules. These modules all collectively +;;; export the whole scsh enchilada. + +(define-structures + ((scsh-level-0 + (compound-interface posix-fdflags-interface + posix-errno-interface + posix-signals-interface + sockets-network-interface ; Standard Network Interface + os-extras-interface ; Extra stuff from OS. + scsh-delimited-readers-interface + scsh-errors-interface + scsh-io-interface + scsh-file-interface + scsh-process-interface + scsh-process-state-interface + scsh-user/group-db-interface + scsh-command-line-interface + scsh-signals-interface + scsh-environment-interface + scsh-home-interface + scsh-string-interface + scsh-file-names-interface + scsh-misc-interface + scsh-high-level-process-interface + scsh-time-interface ; new in 0.2 + scsh-sockets-interface ; new in 0.3 + scsh-endian-interface + tty-interface ; new in 0.4 + scsh-version-interface + (interface-of srfi-14) ;; export this here for + (export ->char-set) ;; this kludge + signal-handler-interface + ;; This stuff would probably be better off kept + ;; in separate modules, but we'll toss it in for now. + (interface-of ascii) ; char<->ascii + string-ports-interface + syslog-interface + crypt-interface + uname-interface + )) + (scsh-level-0-internals (export set-command-line-args! + init-scsh-hindbrain + initialize-cwd + init-scsh-vars)) +; (scsh-regexp-package scsh-regexp-interface) +) + (for-syntax (open scsh-syntax-helpers scheme)) + (access rts-sigevents sigevents threads) + (open enumerated + defenum-package + external-calls ;JMG new FFI + structure-refs + receiving + defrec-package + define-record-types + formats + string-collectors + delimited-readers + os-dependent ; OS dependent stuff + buffered-io-flags ; stdio dependent + ascii + records + extended-ports + ports + build + bigbit + bitwise + signals + conditions + (subset srfi-1 (filter reverse! fold delete any)) + scsh-utilities + handle + fluids thread-fluids + weak-tables + (subset srfi-1 (last drop-right)) + + srfi-14 +; scsh-regexp-package +; scsh-regexp-internals + scsh-version + tty-flags + scsh-internal-tty-flags ; Not exported + + syslog + + let-opt ; optional-arg parsing & defaulting + + architecture ; Was this by JMG ?? + + re-level-0 + rx-syntax + + srfi-13 + + thread-fluids ; For exec-path-list + loopholes ; For my bogus CALL-TERMINALLY implementation. + + (modify scheme (hide call-with-input-file + call-with-output-file + with-input-from-file + with-output-to-file + open-input-file + open-output-file)) + + low-interrupt ; for sighandler and procobj + ;; all these seem to be for scsh-0.6 JMG + i/o + i/o-internal + channels channel-i/o + low-channels + byte-vectors + threads locks placeholders + primitives + escapes + command-levels + features + general-tables + simple-syntax + exit-hooks + display-conditions + + scsh-endian) + (for-syntax (open scsh-syntax-helpers scheme)) + (access interrupts + sort + command-processor + escapes + i/o ; S48's force-output + exceptions ; signal-exception + formats + threads-internal + records ; I don't think this is necessary. !!! + scheme) ; For accessing the normal I/O operators. + (files syntax + scsh-condition + syscalls + fname + rw + newports + fdports + procobj ; New in release 0.4. + (machine waitcodes) ; OS dependent code. + filesys + fileinfo + glob + filemtch + time ; New in release 0.2. + (machine time_dep) + network ; New in release 0.3. + flock ; New in release 0.4. + tty ; New in release 0.4. + pty ; New in release 0.4. + sighandlers ; New in release 0.5. + scsh +; re + ) +; (optimize auto-integrate) + (begin + ;; work around for SRFI 14 naming fuckage + (define ->char-set x->char-set)) + ) + +(define-structure defrec-package (export (define-record :syntax)) + (open records scheme) + (for-syntax (open scheme error-package receiving)) + (files defrec) +; (optimize auto-integrate) + ) + +(define-structure defenum-package (export (define-enum-constant :syntax) + (define-enum-constants :syntax) + (define-enum-constants-from-zero + :syntax)) + (open scheme) + (files enumconst) +; (optimize auto-integrate) + ) + +;;; This code opens so many modules of gruesome, low-level S48 internals +;;; that these two modules are segregated into separate packages, each +;;; exporting just two definitions. + +(define-structure scsh-startup-package (export dump-scsh-program + dump-scsh + make-scsh-starter + scsh-stand-alone-resumer) + (open scsh-level-0-internals ; init-scsh-* set-command-line-args! + scsh-level-0 ; error-output-port command-line-arguments + scsh-top-package ; parse-switches-and-execute + handle ; with-handler + command-levels ; user-context + write-images ; write-image + build-internals ; simple-condition-handler + low-level ; flush-the-symbol-table! + command-processor ; command-output + package-commands-internal + filenames ; translate + usual-resumer ; usual-resumer + environments ; with-interaction-environment + fluids-internal ; JMG: get-dynamic-env + threads threads-internal queues scheduler + structure-refs + scsh-utilities + interrupts + low-interrupt + sigevents + primitives + (modify scheme (hide call-with-input-file + call-with-output-file + with-input-from-file + with-output-to-file + open-input-file + open-output-file))) + (access threads-internal) + (files startup)) + +(define-structure scsh-top-package (export parse-switches-and-execute + with-scsh-initialized) + (open command-processor + command-levels ; with-new-session + conditions + display-conditions + ensures-loaded + environments + error-package + evaluation + extended-ports + fluids + interfaces + sigevents + low-interrupt + fluids-internal ; JMG: get-dynamic-env + handle ; JMG: with-handler +; package-commands + interrupts + i/o + package-commands-internal + package-mutation + packages + receiving + scsh-version + scsh-level-0 ; with-current-input-port error-output-port + ; with-current-output-port exit + scsh-level-0-internals ; set-command-line-args! init-scsh-vars + threads + lib-dirs + lib-dirs-internal + (subset srfi-14 (char-set + char-set-complement! + char-set-contains? + string->char-set)) + root-scheduler ; scheme-exit-now + exit-hooks + scheme) + (files top meta-arg)) + +(define-structure exit-hooks exit-hooks-interface + (open scheme + threads) + (begin + (define *exit-hooks* '()) + (define (add-exit-hook! thunk) + (set! *exit-hooks* (cons thunk *exit-hooks*))) + (define (call-exit-hooks!) + (for-each (lambda (thunk) (thunk)) *exit-hooks*)) + + (define *narrowed-exit-hooks* '()) + (define (add-narrowed-exit-hook! thunk) + (set! *narrowed-exit-hooks* (cons thunk *narrowed-exit-hooks*))) + (define (call-narrowed-exit-hooks!) + (for-each (lambda (thunk) (thunk)) *narrowed-exit-hooks*)) + + (define (call-exit-hooks-and-narrow thunk) + (call-exit-hooks!) + (narrow + (lambda () + (call-narrowed-exit-hooks!) + (thunk)))))) + + +(define-structure field-reader-package scsh-field-reader-interface + (open receiving ; receive + scsh-utilities ; deprecated-proc + error-package ; error + (subset srfi-13 (string-join)) + (subset srfi-14 (char-set? + char-set:whitespace + char-set + x->char-set + char-set-complement)) + delimited-readers + re-exports + let-opt ; optional-arg parsing & defaulting + scheme + ) + (files fr) + ;; Handle a little bit of backwards compatibility. + (begin (define join-strings (deprecated-proc string-join 'join-strings + "Use SRFI-13 STRING-JOIN."))) + ) + + +(define-structures + ((awk-expander-package (export expand-awk expand-awk/obsolete)) + (awk-support-package (export next-range next-:range + next-range: next-:range:))) + (open receiving ; receive + ;; scsh-utilities + (subset srfi-1 (any filter)) + error-package ; error +; scsh-regexp-package +; re-exports + sre-syntax-tools + scheme + ) + (files awk) +; (optimize auto-integrate) +) + + +(define-structure awk-package awk-interface + (open awk-support-package ; These packages provide all the stuff + re-exports ; that appears in the code produced by + receiving ; an awk expansion. + scheme) + (for-syntax (open awk-expander-package scheme)) + (begin (define-syntax awk expand-awk) + (define-syntax awk/posix-string expand-awk/obsolete))) + +;;; Exports an AWK macro that is just AWK/POSIX-STRING. +(define-structure obsolete-awk-package (export (awk :syntax)) + (open awk-package) + (begin (define-syntax awk + (syntax-rules () ((awk body ...) (awk/posix-string body ....)))))) + +(define-structure scsh + (compound-interface (interface-of scsh-level-0) + (interface-of scsh-startup-package) +; scsh-regexp-interface + re-exports-interface + re-old-funs-interface + scsh-field-reader-interface ; new in 0.3 +; scsh-dbm-interface + awk-interface + char-predicates-interface; Urk -- Some of this is R5RS! + dot-locking-interface + md5-interface + configure-interface + lib-dirs-interface + ) + + (open structure-refs + scsh-level-0 + scsh-level-0-internals + re-exports + re-old-funs +; scsh-regexp-package + scsh-startup-package +; dbm + awk-package + field-reader-package + char-predicates-lib ; Urk -- Some of this is R5RS! + dot-locking + md5 + configure + lib-dirs + scheme) + + (access scsh-top-package) +; (optimize auto-integrate) + ) + +(define-structure scheme-with-scsh + (compound-interface (interface-of scsh) + (interface-of scheme)) + (open scsh + (modify scheme (hide call-with-input-file + call-with-output-file + with-input-from-file + with-output-to-file + open-input-file + open-output-file)))) + +(define-structure scsh-here-string-hax (export) + (open reading + receiving + scsh ; Just need the delimited readers. + features ; make-immutable! + (subset srfi-14 (char-set)) + scheme) + (files here)) + +(define-structure sigevents sigevents-interface + (open scsh-level-0 + scheme + structure-refs + low-interrupt + rts-sigevents) + (files event)) + +(define-structure simple-syntax (export define-simple-syntax) + (open scheme) + (begin (define-syntax define-simple-syntax + (syntax-rules () + ((define-simple-syntax (name . pattern) result) + (define-syntax name (syntax-rules () ((name . pattern) result)))))))) + + +(define-structure low-interrupt low-interrupt-interface + (open scheme + enumerated + bigbit + bitwise) + (files low-interrupt)) + +;(define-structure test-package (export test-proc) +; (open scsh-regexp-package scheme) +; (begin (define (test-proc p) +; (regexp-substitute p +; (string-match "(foo)(.*)(bar)" "Hello foo Olin bar quux") +; 'post 3 1 2 'pre)))) + + +(define-structure scsh-threads + (export fork/thread + fork/process + wait/thread + wait/process) + (open structure-refs + scheme) + (access scsh-level-0 + threads + threads-internal) + (files threads)) + +(define-structure dot-locking dot-locking-interface + (open scsh-level-0 + scheme + let-opt + threads ; sleep + random) + (files dot-locking)) + +(define-structures ((syslog syslog-interface) + (syslog-channels syslog-channels-interface)) + (open scheme + define-record-types finite-types enum-sets + locks thread-fluids + external-calls + bitwise) + (files syslog)) + +(define-structure libscsh (export dump-libscsh-image) + (open scheme + external-calls + (subset i/o (current-error-port)) + (subset extended-ports (make-string-input-port)) + (subset handle (with-handler)) + (subset escapes (with-continuation)) + (subset environments (with-interaction-environment)) + (subset package-commands-internal (user-environment)) + (subset command-levels (user-context start-new-session)) + (subset command-processor (user-command-environment)) + (subset scsh-startup-package (dump-scsh-program))) + (files libscsh)) + +(define-structure md5 md5-interface + (open scheme + ascii + define-record-types + bitwise + (subset i/o (read-block)) + (subset srfi-13 (string-fold-right)) + signals + external-calls) + (files md5)) + +(define srfi-19 (make-srfi-19 scheme-with-scsh)) + +(define-structure configure configure-interface + (open scheme + re-level-0 rx-syntax + (subset srfi-13 (string-join))) + (files configure)) + +(define-structures ((lib-dirs lib-dirs-interface) + (lib-dirs-internal lib-dirs-internal-interface)) + (open scsh-level-0 + scheme + handle + scsh-utilities + (subset srfi-1 (any))) + (files lib-dirs)) + +(define-structure curses + (export init-screen + newterm + endwin + isendwin + delscreen + unctrl + keyname + filter + use_env + putwin + getwin + delay-output + start-color + init-pair + flushinp + curses-version + use-default-colors + assume-default-colors + define-key + baudrate + erasechar + has_ic + has_il + killchar + longname + termname + has-key + start-color + init-pair + init-color + has-colors + can-change-colors + color-pair + cbreak + nocbreak + echo + noecho + halfdelay + intrflush + keypad + meta + nodelay + raw + noraw + qiflush + noqiflush + beep + flash + def-prog-mode + def-shell-mode + reset-prog-mode + reset-shell-mode + resetty + savetty + curs-set + napms + mcprint + is-term-resized + resize-term + resizeterm + scr-dump + scr-restore + scr-init + scr-set + set-term + newwin + delwin + mvwin + subwin + derwin + mvderwin + dupwin + wsyncup + wcursyncup + wsyncdown + syncok + wrefresh + wnoutrefresh + redrawwin + doupdate + wredrawln + ;;getyx + ;;getparyx + ;;getbegyx + ;;getmaxyx + gety + getx + getmaxy + getmaxx + wresize + idlok + leaveok + scrollok + idcok + immedok + wsetscrreg + nl + nonl + waddch + waddstr + waddnstr + winsch + winsstr + winsnstr + wechochar + wattroff + wattron + wattrset + wstandend + wstandout + wbkgdset + wbkgd + getbkgd + wborder + box + whline + wvline + scroll + wscrl + wmove + wgetch + wgetstr + wgetnstr + winch + winstr + winnstr + werase + wclear + wclrtobot + wclrtoeol + clearok + wdelch + wdeleteln + winsertln + winsdelln + overlay + overwrite + copywin + touchline + touchwin + untouchwin + wtouchln + is-linetouched + is-wintouched + wprintw + newpad + subpad + prefresh + pnoutrefresh + pechochar + standard-screen + COLS + LINES + A-NORMAL + A-STANDOUT + A-UNDERLINE + A-REVERSE + A-BLINK + A-DIM + A-BOLD + A-PROTECT + A-INVIS + A-ALTCHARSET + COLOR-BLACK + COLOR-RED + COLOR-GREEN + COLOR-YELLOW + COLOR-BLUE + COLOR-MAGENTA + COLOR-CYAN + COLOR-WHITE + refresh + move + setscrreg + scrl + printw + clear + addch + echochar + addstr + addnstr + insch + insstr + insnstr + printw + attroff + attron + attrset + standend + standout + bkgdset + bkgd + border + hline + vline + getch + getstr + getnstr + erase + clear + clrtobot + clrtoeol + delch + deleteln + insdelln + insertln + mvwaddch + mvwaddstr + mvwaddnstr + mvwinsch + mvwinsstr + mvwinsnstr + mvwprintw + mvwhline + mvwvline + mvwgetch + mvwgetstr + mvwgetnstr + mvwdelch + set-stdscr-internal + set-standard-screen + make-window + window-c-pointer + + color-black + color-red + color-green + color-yellow + color-blue + color-magenta + color-cyan + color-white + + key-code-yes + key-min + key-break + key-sreset + key-reset + key-down + key-up + key-left + key-right + key-home + key-backspace + key-f0 + key-f1 + key-f2 + key-f3 + key-f4 + key-f5 + key-f6 + key-f7 + key-f8 + key-f9 + key-f10 + key-f11 + key-f12 + key-dl + key-il + key-dc + key-ic + key-eic + key-clear + key-eos + key-eol + key-sf + key-sr + key-npage + key-ppage + key-stab + key-ctab + key-catab + key-enter + key-print + key-ll + key-a1 + key-a3 + key-b2 + key-c1 + key-c3 + key-btab + key-beg + key-cancel + key-close + key-command + key-copy + key-create + key-end + key-exit + key-find + key-help + key-mark + key-message + key-move + key-next + key-open + key-options + key-previous + key-redo + key-reference + key-refresh + key-replace + key-restart + key-resume + key-save + key-sbeg + key-scancel + key-scommand + key-scopy + key-screate + key-sdc + key-sdl + key-select + key-send + key-seol + key-sexit + key-sfind + key-shelp + key-shome + key-sic + key-sleft + key-smessage + key-smove + key-snext + key-soptions + key-sprevious + key-sprint + key-sredo + key-sreplace + key-sright + key-srsume + key-ssave + key-ssuspend + key-sundo + key-suspend + key-undo + key-mouse + key-resize + key-event) + (open scsh-level-0 + scheme + external-calls + define-record-types + conditions + signals + handle) + (files curses + ncurses-constants))