483 Lines
/* * Scheme 9 from Empty Space, Curses Interface * By Nils M Holm, 2010-2015 * Placed in the Public Domain * * A low-level interface to some CURSES(3) routines. */ #include "s9core.h" #include "s9import.h" #include "s9ext.h" /* * XXX The C "macro" preprocessor does not allow to do this * in a more consistent way, so the following values have to * be *copied* from s9core.h. *Sigh* */ #define S9_TRUE (-2) #define S9_FALSE (-3) #define _nl() pr("\n") #undef nl #undef TRUE #undef FALSE #include <stdlib.h> #include <curses.h> static int Curses_running = 0; cell pp_curs_addch(void) { if (!Curses_running) return UNSPECIFIC; addch(char_value(parg(1))); return UNSPECIFIC; } cell pp_curs_addstr(void) { if (!Curses_running) return UNSPECIFIC; addstr(string(parg(1))); return UNSPECIFIC; } cell pp_curs_attrset(void) { if (!Curses_running) return UNSPECIFIC; attrset(integer_value("curs:attrset", parg(1))); return UNSPECIFIC; } cell pp_curs_beep(void) { if (!Curses_running) return UNSPECIFIC; beep(); return UNSPECIFIC; } cell pp_curs_cbreak(void) { if (!Curses_running) return UNSPECIFIC; cbreak(); return UNSPECIFIC; } cell pp_curs_clear(void) { if (!Curses_running) return UNSPECIFIC; clear(); return UNSPECIFIC; } cell pp_curs_clearok(void) { if (!Curses_running) return UNSPECIFIC; clearok(stdscr, parg(1) == S9_TRUE? TRUE: FALSE); return UNSPECIFIC; } cell pp_curs_clrtobot(void) { if (!Curses_running) return UNSPECIFIC; clrtobot(); return UNSPECIFIC; } cell pp_curs_clrtoeol(void) { if (!Curses_running) return UNSPECIFIC; clrtoeol(); return UNSPECIFIC; } cell pp_curs_cols(void) { return make_integer(COLS); } cell pp_curs_cursoff(void) { if (!Curses_running) return UNSPECIFIC; curs_set(0); return UNSPECIFIC; } cell pp_curs_curson(void) { if (!Curses_running) return UNSPECIFIC; curs_set(1); return UNSPECIFIC; } cell pp_curs_delch(void) { if (!Curses_running) return UNSPECIFIC; delch(); return UNSPECIFIC; } cell pp_curs_deleteln(void) { if (!Curses_running) return UNSPECIFIC; deleteln(); return UNSPECIFIC; } cell pp_curs_echo(void) { if (!Curses_running) return UNSPECIFIC; echo(); return UNSPECIFIC; } cell pp_curs_endwin(void) { if (!Curses_running) return UNSPECIFIC; endwin(); Curses_running = 0; return UNSPECIFIC; } cell pp_curs_flash(void) { if (!Curses_running) return UNSPECIFIC; flash(); return UNSPECIFIC; } cell pp_curs_flushinp(void) { if (!Curses_running) return UNSPECIFIC; flushinp(); return UNSPECIFIC; } cell pp_curs_get_magic_value(void) { char *s = string(parg(1)); if (!strcmp(s, "A_BOLD")) return make_integer(A_BOLD); if (!strcmp(s, "A_NORMAL")) return make_integer(A_NORMAL); if (!strcmp(s, "A_STANDOUT")) return make_integer(A_STANDOUT); if (!strcmp(s, "A_UNDERLINE")) return make_integer(A_UNDERLINE); if (!strcmp(s, "KEY_BACKSPACE")) return make_integer(KEY_BACKSPACE); if (!strcmp(s, "KEY_DC")) return make_integer(KEY_DC); if (!strcmp(s, "KEY_DOWN")) return make_integer(KEY_DOWN); if (!strcmp(s, "KEY_END")) return make_integer(KEY_END); if (!strcmp(s, "KEY_IC")) return make_integer(KEY_IC); if (!strcmp(s, "KEY_HOME")) return make_integer(KEY_HOME); if (!strcmp(s, "KEY_LEFT")) return make_integer(KEY_LEFT); if (!strcmp(s, "KEY_NPAGE")) return make_integer(KEY_NPAGE); if (!strcmp(s, "KEY_PPAGE")) return make_integer(KEY_PPAGE); if (!strcmp(s, "KEY_RIGHT")) return make_integer(KEY_RIGHT); if (!strcmp(s, "KEY_UP")) return make_integer(KEY_UP); error("curs:get-magic-value: requested value not found", parg(1)); return UNDEFINED; } cell pp_curs_getch(void) { int c; if (!Curses_running) return UNSPECIFIC; c = getch(); if (c == ERR) return S9_FALSE; return make_integer(c); } cell pp_curs_getyx(void) { int cx, cy; cell n; if (!Curses_running) return UNSPECIFIC; getyx(stdscr, cy, cx); n = make_integer(cx); n = cons(n, NIL); save(n); n = cons(make_integer(cy), n); unsave(1); return n; } cell pp_curs_idlok(void) { if (!Curses_running) return UNSPECIFIC; idlok(stdscr, parg(1) == S9_TRUE? TRUE: FALSE); return UNSPECIFIC; } cell pp_curs_inch(void) { if (!Curses_running) return UNSPECIFIC; return make_char(inch()); } cell pp_curs_insch(void) { if (!Curses_running) return UNSPECIFIC; insch(char_value(parg(1))); return UNSPECIFIC; } #ifdef CURSES_COLOR cell pp_curs_initscr(void) { int colors[] = { COLOR_BLACK, COLOR_BLUE, COLOR_GREEN, COLOR_CYAN, COLOR_RED, COLOR_MAGENTA, COLOR_YELLOW, COLOR_WHITE }; int f, b; if (Curses_running) return UNSPECIFIC; initscr(); start_color(); for (b=0; b<8; b++) { for (f=0; f<8; f++) { init_pair(b*8+f, colors[f], colors[b]); } } Curses_running = 1; return UNSPECIFIC; } cell pp_curs_color_set(void) { int f, b; char name[] = "curs:color-set"; f = integer_value(name, parg(1)); b = integer_value(name, parg(2)); color_set(b<<3|f, NULL); return UNSPECIFIC; } cell pp_curs_has_colors(void) { return has_colors()? S9_TRUE: S9_FALSE; } #else /* !CURSES_COLOR */ cell pp_curs_has_colors(void) { return S9_FALSE; } cell pp_curs_initscr(void) { if (Curses_running) return UNSPECIFIC; initscr(); Curses_running = 1; return UNSPECIFIC; } #endif /* !CURSES_COLOR */ cell pp_curs_insertln(void) { if (!Curses_running) return UNSPECIFIC; insertln(); return UNSPECIFIC; } cell pp_curs_keypad(void) { if (!Curses_running) return UNSPECIFIC; keypad(stdscr, parg(1) == S9_TRUE? TRUE: FALSE); return UNSPECIFIC; } cell pp_curs_lines(void) { return make_integer(LINES); } cell pp_curs_move(void) { char name[] = "curs:move"; if (!Curses_running) return UNSPECIFIC; move(integer_value(name, parg(1)), integer_value(name, parg(2))); return UNSPECIFIC; } cell pp_curs_mvaddch(void) { char name[] = "curs:mvaddch"; if (!Curses_running) return UNSPECIFIC; mvaddch(integer_value(name, parg(1)), integer_value(name, parg(2)), char_value(parg(3))); return UNSPECIFIC; } cell pp_curs_mvaddstr(void) { char name[] = "curs:mvaddstr"; if (!Curses_running) return UNSPECIFIC; mvaddstr(integer_value(name, parg(1)), integer_value(name, parg(2)), string(parg(3))); return UNSPECIFIC; } cell pp_curs_mvcur(void) { char name[] = "curs:mvcur"; if (!Curses_running) return UNSPECIFIC; if (!integer_p(parg(4))) error("curs:mvcur: expected integer, got", parg(4)); mvcur(integer_value(name, parg(1)), integer_value(name, parg(2)), integer_value(name, parg(3)), integer_value(name, parg(4))); return UNSPECIFIC; } cell pp_curs_mvdelch(void) { char name[] = "curs:mvdelch"; if (!Curses_running) return UNSPECIFIC; mvdelch(integer_value(name, parg(1)), integer_value(name, parg(2))); return UNSPECIFIC; } cell pp_curs_mvgetch(void) { char name[] = "curs:mvgetch"; int c; if (!Curses_running) return UNSPECIFIC; c = mvgetch(integer_value(name, parg(1)), integer_value(name, parg(2))); if (c == ERR) return S9_FALSE; return make_integer(c); } cell pp_curs_mvinch(void) { char name[] = "curs:mvinch"; if (!Curses_running) return UNSPECIFIC; return make_char((int) mvinch(integer_value(name, parg(1)), integer_value(name, parg(2)))); } cell pp_curs_mvinsch(void) { char name[] = "curs:mvinsch"; if (!Curses_running) return UNSPECIFIC; mvinsch(integer_value(name, parg(1)), integer_value(name, parg(2)), char_value(parg(3))); return UNSPECIFIC; } cell pp_curs_nl(void) { if (!Curses_running) return UNSPECIFIC; nl(); return UNSPECIFIC; } cell pp_curs_nocbreak(void) { if (!Curses_running) return UNSPECIFIC; nocbreak(); return UNSPECIFIC; } cell pp_curs_nodelay(void) { if (!Curses_running) return UNSPECIFIC; nodelay(stdscr, parg(1) == S9_TRUE? TRUE: FALSE); return UNSPECIFIC; } cell pp_curs_noecho(void) { if (!Curses_running) return UNSPECIFIC; noecho(); return UNSPECIFIC; } cell pp_curs_nonl(void) { if (!Curses_running) return UNSPECIFIC; nonl(); return UNSPECIFIC; } cell pp_curs_noraw(void) { if (!Curses_running) return UNSPECIFIC; noraw(); return UNSPECIFIC; } cell pp_curs_raw(void) { if (!Curses_running) return UNSPECIFIC; raw(); return UNSPECIFIC; } cell pp_curs_refresh(void) { if (!Curses_running) return UNSPECIFIC; refresh(); return UNSPECIFIC; } cell pp_curs_resetty(void) { if (!Curses_running) return UNSPECIFIC; resetty(); return UNSPECIFIC; } cell pp_curs_savetty(void) { if (!Curses_running) return UNSPECIFIC; savetty(); return UNSPECIFIC; } cell pp_curs_scroll(void) { if (!Curses_running) return UNSPECIFIC; scrl(integer_value("curs:scroll", parg(1))); return UNSPECIFIC; } cell pp_curs_scrollok(void) { if (!Curses_running) return UNSPECIFIC; scrollok(stdscr, parg(1) == S9_TRUE? TRUE: FALSE); return UNSPECIFIC; } cell pp_curs_unctrl(void) { char *s; if (!Curses_running) return UNSPECIFIC; s = (char *) unctrl(integer_value("curs:unctrl", parg(1))); return make_string(s, strlen(s)); } cell pp_curs_ungetch(void) { if (!Curses_running) return UNSPECIFIC; ungetch(integer_value("curs:ungetch", parg(1))); return UNSPECIFIC; } S9_PRIM Curs_primitives[] = { { "curs:addch", pp_curs_addch, 1, 1, { CHR,___,___ } }, { "curs:addstr", pp_curs_addstr, 1, 1, { STR,___,___ } }, { "curs:attrset", pp_curs_attrset, 1, 1, { INT,___,___ } }, { "curs:beep", pp_curs_beep, 0, 0, { ___,___,___ } }, { "curs:cbreak", pp_curs_cbreak, 0, 0, { ___,___,___ } }, { "curs:clear", pp_curs_clear, 0, 0, { ___,___,___ } }, { "curs:clearok", pp_curs_clearok, 1, 1, { BOL,___,___ } }, { "curs:clrtobot", pp_curs_clrtobot, 0, 0, { ___,___,___ } }, { "curs:clrtoeol", pp_curs_clrtoeol, 0, 0, { ___,___,___ } }, #ifdef CURSES_COLOR { "curs:color-set", pp_curs_color_set, 2, 2, { INT,INT,___ } }, #endif /* CURSES_COLOR */ { "curs:cols", pp_curs_cols, 0, 0, { ___,___,___ } }, { "curs:cursoff", pp_curs_cursoff, 0, 0, { ___,___,___ } }, { "curs:curson", pp_curs_curson, 0, 0, { ___,___,___ } }, { "curs:delch", pp_curs_delch, 0, 0, { ___,___,___ } }, { "curs:deleteln", pp_curs_deleteln, 0, 0, { ___,___,___ } }, { "curs:echo", pp_curs_echo, 0, 0, { ___,___,___ } }, { "curs:endwin", pp_curs_endwin, 0, 0, { ___,___,___ } }, { "curs:flash", pp_curs_flash, 0, 0, { ___,___,___ } }, { "curs:flushinp", pp_curs_flushinp, 0, 0, { ___,___,___ } }, { "curs:get-magic-value", pp_curs_get_magic_value, 1, 1, { STR,___,___ } }, { "curs:getch", pp_curs_getch, 0, 0, { ___,___,___ } }, { "curs:getyx", pp_curs_getyx, 0, 0, { ___,___,___ } }, { "curs:has-colors", pp_curs_has_colors, 0, 0, { ___,___,___ } }, { "curs:idlok", pp_curs_idlok, 1, 1, { BOL,___,___ } }, { "curs:inch", pp_curs_inch, 0, 0, { ___,___,___ } }, { "curs:insch", pp_curs_insch, 1, 1, { CHR,___,___ } }, { "curs:initscr", pp_curs_initscr, 0, 0, { ___,___,___ } }, { "curs:insertln", pp_curs_insertln, 0, 0, { ___,___,___ } }, { "curs:keypad", pp_curs_keypad, 1, 1, { BOL,___,___ } }, { "curs:lines", pp_curs_lines, 0, 0, { ___,___,___ } }, { "curs:move", pp_curs_move, 2, 2, { INT,INT,___ } }, { "curs:mvaddch", pp_curs_mvaddch, 3, 3, { INT,INT,CHR } }, { "curs:mvaddstr", pp_curs_mvaddstr, 3, 3, { INT,INT,STR } }, { "curs:mvcur", pp_curs_mvcur, 2, 2, { INT,INT,___ } }, { "curs:mvdelch", pp_curs_mvdelch, 2, 2, { INT,INT,___ } }, { "curs:mvgetch", pp_curs_mvgetch, 2, 2, { INT,INT,___ } }, { "curs:mvinch", pp_curs_mvinch, 2, 2, { INT,INT,___ } }, { "curs:mvinsch", pp_curs_mvinsch, 2, 2, { INT,INT,___ } }, { "curs:nl", pp_curs_nl, 0, 0, { ___,___,___ } }, { "curs:nocbreak", pp_curs_nocbreak, 0, 0, { ___,___,___ } }, { "curs:nodelay", pp_curs_nodelay, 1, 1, { BOL,___,___ } }, { "curs:noecho", pp_curs_noecho, 0, 0, { ___,___,___ } }, { "curs:nonl", pp_curs_nonl, 0, 0, { ___,___,___ } }, { "curs:noraw", pp_curs_noraw, 0, 0, { ___,___,___ } }, { "curs:raw", pp_curs_raw, 0, 0, { ___,___,___ } }, { "curs:refresh", pp_curs_refresh, 0, 0, { ___,___,___ } }, { "curs:resetty", pp_curs_resetty, 0, 0, { ___,___,___ } }, { "curs:savetty", pp_curs_savetty, 0, 0, { ___,___,___ } }, { "curs:scroll", pp_curs_scroll, 1, 1, { INT,___,___ } }, { "curs:scrollok", pp_curs_scrollok, 1, 1, { BOL,___,___ } }, { "curs:unctrl", pp_curs_unctrl, 1, 1, { INT,___,___ } }, { "curs:ungetch", pp_curs_ungetch, 1, 1, { INT,___,___ } }, { NULL } }; void curs_init(void) { add_primitives("curses", Curs_primitives); }