Back to index

plt-scheme  4.2.1
curses.c
Go to the documentation of this file.
00001 /*
00002   Extension that uses the curses library.
00003 
00004   Link the extension to the curses library like this:
00005      mzc --ld hello.so hello.o -lcurses
00006 
00007   For obvious reasons, this library doesn't interact well
00008   with MzScheme's read-eval-print loop. The example file
00009   curses-demo.ss demos this extension.
00010 */
00011 
00012 #include "escheme.h"
00013 #include <curses.h>
00014 
00015 /**************************************************/
00016 
00017 static Scheme_Object *sch_clear(int argc, Scheme_Object **argv)
00018 {
00019   clear();
00020 }
00021 
00022 static Scheme_Object *sch_put(int argc, Scheme_Object **argv)
00023 {
00024   /* Puts a char or string on the screen */
00025   if (SCHEME_CHARP(argv[0]))
00026     addch(SCHEME_CHAR_VAL(argv[0]));
00027   else if (SCHEME_BYTE_STRINGP(argv[0]))
00028     addstr(SCHEME_BYTE_STR_VAL(argv[0]));
00029   else if (SCHEME_CHAR_STRINGP(argv[0])) {
00030     Scheme_Object *bs;
00031     bs = scheme_char_string_to_byte_string(argv[0]);
00032     addstr(SCHEME_BYTE_STR_VAL(bs));
00033   } else
00034     scheme_wrong_type("put", "character, string, or byte string", 0, argc, argv);
00035 
00036   return scheme_void;
00037 }
00038 
00039 static Scheme_Object *sch_get(int argc, Scheme_Object **argv)
00040 {
00041   /* Gets keyboard input */
00042   int c = getch();
00043   return scheme_make_character(c);
00044 }
00045 
00046 static Scheme_Object *sch_move(int argc, Scheme_Object **argv)
00047 {
00048   /* Move the output cursor */
00049   if (!SCHEME_INTP(argv[0]))
00050     scheme_wrong_type("move", "exact integer", 0, argc, argv);
00051   if (!SCHEME_INTP(argv[1]))
00052     scheme_wrong_type("move", "exact integer", 1, argc, argv);
00053 
00054   move(SCHEME_INT_VAL(argv[0]), SCHEME_INT_VAL(argv[1]));
00055 
00056   return scheme_void;
00057 }
00058 
00059 static Scheme_Object *sch_get_size(int argc, Scheme_Object **argv)
00060 {
00061   /* Returns two values */
00062   int w, h;
00063   Scheme_Object *a[2];
00064 
00065   w = getmaxx(stdscr);
00066   h = getmaxy(stdscr);
00067 
00068   a[0] = scheme_make_integer(w);
00069   a[1] = scheme_make_integer(h);
00070   return scheme_values(1, a);
00071 }
00072 
00073 static Scheme_Object *sch_refresh(int argc, Scheme_Object **argv)
00074 {
00075   refresh();
00076   return scheme_void;
00077 }
00078 
00079 /**************************************************/
00080 
00081 Scheme_Object *scheme_reload(Scheme_Env *env)
00082 {
00083   /* The MZ_GC... lines are for for 3m, because env is live across an
00084      allocating call. They're not needed for plain old (conservatively
00085      collected) Mzscheme. See makeadder3m.c for more info. */
00086   Scheme_Object *v;
00087   MZ_GC_DECL_REG(1);
00088   MZ_GC_VAR_IN_REG(0, env);
00089   MZ_GC_REG();
00090 
00091   v = scheme_make_prim_w_arity(sch_clear, "clear", 0, 0),
00092   scheme_add_global("clear", v, env);
00093 
00094   v = scheme_make_prim_w_arity(sch_put, "put", 1, 1);
00095   scheme_add_global("put", v, env);
00096 
00097   v = scheme_make_prim_w_arity(sch_get, "get", 0, 0);
00098   scheme_add_global("get", v, env);
00099 
00100   v = scheme_make_prim_w_arity(sch_move, "move", 2, 2);
00101   scheme_add_global("move", v, env);
00102 
00103   v = scheme_make_prim_w_arity(sch_get_size, "get-size", 0, 0);
00104   scheme_add_global("get-size", v, env);
00105 
00106   v = scheme_make_prim_w_arity(sch_refresh, "refresh", 0, 0);
00107   scheme_add_global("refresh", v, env);
00108 
00109   MZ_GC_UNREG();
00110 
00111   return scheme_void;
00112 }
00113 
00114 Scheme_Object *scheme_initialize(Scheme_Env *env)
00115 {
00116   /* The first time we're loaded, initialize the screen: */
00117   initscr();
00118   cbreak();
00119   noecho();
00120   atexit(endwin);
00121 
00122   /* Then do the usual stuff: */
00123   return scheme_reload(env);
00124 }
00125 
00126 Scheme_Object *scheme_module_name()
00127 {
00128   /* This extension doesn't define a module: */
00129   return scheme_false;
00130 }