From 8c423c7a05215ef10cd209113b3473bccb058c4f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Thorsten=20Wi=C3=9Fmann?= <uni@thorsten-wissmann.de>
Date: Sun, 27 Jul 2014 19:43:19 +0200
Subject: [PATCH] Add curses painting basics
---
_oasis | 2 +-
src/ncurses/Curses.ml | 1 +
src/ncurses/Curses.mli | 1 +
src/ncurses/Curses_stub.c | 12 ++++++
src/ncurses/NCUI.ml | 70 ++++++++++++++++++++++++++++++++
src/ncurses/NCUI.mli | 28 +++++++++++++
src/repl-example/repl-example.ml | 8 +++-
7 files changed, 120 insertions(+), 2 deletions(-)
create mode 100644 src/ncurses/NCUI.ml
create mode 100644 src/ncurses/NCUI.mli
diff --git a/_oasis b/_oasis
index 9c0c415..8fb6893 100644
--- a/_oasis
+++ b/_oasis
@@ -88,7 +88,7 @@ Library interfacencurses
CCOpt: -std=c++98 -x c++
CSources: Curses_stub.c, Readline_stub.c
#InternalModules:
- Modules: Curses, Readline
+ Modules: Curses, Readline, NCUI
Executable coalg
CompiledObject: native
diff --git a/src/ncurses/Curses.ml b/src/ncurses/Curses.ml
index 066502b..e29f596 100644
--- a/src/ncurses/Curses.ml
+++ b/src/ncurses/Curses.ml
@@ -13,4 +13,5 @@ external addch: char -> unit = "curses_addch"
external mvwaddch: window -> int -> int -> char -> unit = "curses_mvwaddch"
external addstr: string -> unit = "curses_addstr"
external mvwaddstr: window -> int -> int -> string -> unit = "curses_mvwaddstr"
+external getmaxyx: window -> int * int = "curses_getmaxyx"
diff --git a/src/ncurses/Curses.mli b/src/ncurses/Curses.mli
index ba96dc5..ac9b369 100644
--- a/src/ncurses/Curses.mli
+++ b/src/ncurses/Curses.mli
@@ -12,3 +12,4 @@ val addch: char -> unit
val mvwaddch: window -> int -> int -> char -> unit
val addstr: string -> unit
val mvwaddstr: window -> int -> int -> string -> unit
+val getmaxyx: window -> int * int
diff --git a/src/ncurses/Curses_stub.c b/src/ncurses/Curses_stub.c
index af4a03f..39ee0c0 100644
--- a/src/ncurses/Curses_stub.c
+++ b/src/ncurses/Curses_stub.c
@@ -100,4 +100,16 @@ value curses_mvwaddstr(value win, value x, value y, value s)
CAMLreturn (Val_unit);
}
+value curses_getmaxyx(value win)
+{
+ CAMLparam1 (win);
+ int h, w;
+ CAMLlocal1( hw );
+ hw = caml_alloc(2, 0);
+ getmaxyx(Window_val(win), h, w);
+ Store_field( hw, 0, Val_int(h) );
+ Store_field( hw, 1, Val_int(w) );
+ CAMLreturn ( hw );
+}
+
}
diff --git a/src/ncurses/NCUI.ml b/src/ncurses/NCUI.ml
new file mode 100644
index 0000000..eb64745
--- /dev/null
+++ b/src/ncurses/NCUI.ml
@@ -0,0 +1,70 @@
+(* a simple NCurses UI Library *)
+open Curses
+
+type point = int * int (* x and y *)
+
+type buffer = string list
+
+exception ScreenNotOpen
+exception NoRootWidget
+
+type 'a member = {
+ set : 'a -> unit;
+ get : unit -> 'a
+}
+
+type widget = {
+ minSize: point member;
+ paint: point -> buffer;
+}
+
+let member_init (v: 'a): 'a member =
+ let pointer = ref (v) in
+ {
+ set = (fun n -> pointer := v);
+ get = (fun () -> !pointer);
+ }
+
+let label str = {
+ minSize = member_init (0,0);
+ paint = (fun (w,h) -> [ str ]);
+ }
+
+let root_widget : widget option ref = ref (None)
+
+let get_root_widget () : widget =
+ match (!root_widget) with
+ | None -> raise NoRootWidget
+ | Some x -> x
+
+let stdscr : window option ref = ref (None)
+
+let screen_open () =
+ stdscr := Some (initscr ())
+
+let get_stdscr () =
+ match (!stdscr) with
+ | None -> raise ScreenNotOpen
+ | Some x -> x
+
+let screen_close () =
+ stdscr := None;
+ endwin ()
+
+let paint_widget (wid:widget) ((x,y):point) (size: point) =
+ let stdscr = get_stdscr () in
+ let lines = wid.paint size in
+ let paint i str =
+ mvwaddstr stdscr (y+i) x str
+ in
+ List.iteri paint lines
+
+let update () =
+ let h, w = getmaxyx (get_stdscr ()) in
+ paint_widget (get_root_widget()) (0,0) (w,h);
+ refresh()
+
+let set_root_widget widget =
+ root_widget := Some widget;
+ update()
+
diff --git a/src/ncurses/NCUI.mli b/src/ncurses/NCUI.mli
new file mode 100644
index 0000000..a67d16c
--- /dev/null
+++ b/src/ncurses/NCUI.mli
@@ -0,0 +1,28 @@
+(* a simple NCurses UI Library *)
+
+type point = int * int (* x and y *)
+
+type buffer = string list
+
+exception ScreenNotOpen
+exception NoRootWidget
+
+
+type 'a member = {
+ set : 'a -> unit;
+ get : unit -> 'a
+}
+
+type widget = {
+ minSize: point member;
+ paint: point -> buffer;
+}
+
+val member_init : 'a -> 'a member
+val label: string -> widget
+
+val update : unit -> unit
+val set_root_widget : widget -> unit
+val screen_open : unit -> unit
+val screen_close : unit -> unit
+
diff --git a/src/repl-example/repl-example.ml b/src/repl-example/repl-example.ml
index 5f93561..e87f607 100644
--- a/src/repl-example/repl-example.ml
+++ b/src/repl-example/repl-example.ml
@@ -22,4 +22,10 @@ let main2 () =
register_redraw redraw ;
Readline.readline()
-let _ = main2 ()
+let main3 () =
+ NCUI.screen_open();
+ NCUI.set_root_widget (NCUI.label "HALLOOOO");
+ Unix.sleep 3;
+ NCUI.screen_close()
+
+let _ = main3 ()
--
GitLab