]> gitweb.factorcode.org Git - factor.git/commitdiff
curses.listener: very basic curses-based listener
authorPhilipp Brüschweiler <blei42@gmail.com>
Thu, 25 Feb 2010 22:15:11 +0000 (23:15 +0100)
committerPhilipp Brüschweiler <blei42@gmail.com>
Sun, 3 Oct 2010 11:17:43 +0000 (13:17 +0200)
extra/curses/listener/authors.txt [new file with mode: 0644]
extra/curses/listener/listener.factor [new file with mode: 0644]
extra/curses/listener/platforms.txt [new file with mode: 0644]
extra/curses/listener/summary.txt [new file with mode: 0644]

diff --git a/extra/curses/listener/authors.txt b/extra/curses/listener/authors.txt
new file mode 100644 (file)
index 0000000..4f30515
--- /dev/null
@@ -0,0 +1 @@
+Philipp Brüschweiler
\ No newline at end of file
diff --git a/extra/curses/listener/listener.factor b/extra/curses/listener/listener.factor
new file mode 100644 (file)
index 0000000..4505c63
--- /dev/null
@@ -0,0 +1,64 @@
+! Copyright (C) 2010 Philipp Brüschweiler.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators continuations curses io io.encodings.string
+io.encodings.utf8 io.streams.plain kernel listener make math
+namespaces sequences ;
+IN: curses.listener
+
+: print-scratchpad ( -- )
+    COLOR_BLACK COLOR_RED ccolor
+    "( scratchpad )" cwrite
+    COLOR_WHITE COLOR_BLACK ccolor
+    " " cwritef ;
+
+! don't handle mouse clicks right now
+: handle-mouse-click ( -- )
+    ;
+
+: delchar ( y x -- )
+    [ cmove CHAR: space addch ] [ cmove ] 2bi ;
+
+: move-left ( -- )
+    get-yx [
+        [ 1 - get-max-x 1 - delchar ] unless-zero
+    ] [ 1 - delchar ] if-zero ;
+
+: handle-backspace ( -- )
+    building get [ pop* move-left ] unless-empty ;
+
+: curses-stream-readln ( -- )
+    getch dup CHAR: \n = [ addch ] [
+        {
+            { KEY_MOUSE [ handle-mouse-click ] }
+            { 127 [ handle-backspace ] }
+            { 4 [ return ] }    ! ^D
+            [ [ , ] [ addch ] bi ]
+        } case
+        curses-stream-readln
+    ] if ;
+
+SINGLETON: curses-listener-stream
+
+M: curses-listener-stream stream-readln
+    drop [ curses-stream-readln ] B{ } make utf8 decode ;
+
+M: curses-listener-stream stream-write
+    drop cwrite ;
+
+M: curses-listener-stream stream-flush
+    drop crefresh ;
+
+M: curses-listener-stream stream-nl
+    drop cnl ;
+
+INSTANCE: curses-listener-stream plain-writer
+
+: run-listener ( -- )
+    <curses-window> [
+        curses-listener-stream dup [ listener ] with-streams*
+    ] with-curses ;
+
+: test-listener ( -- )
+    global [ run-listener ] bind ;
+
+MAIN: run-listener
diff --git a/extra/curses/listener/platforms.txt b/extra/curses/listener/platforms.txt
new file mode 100644 (file)
index 0000000..509143d
--- /dev/null
@@ -0,0 +1 @@
+unix
diff --git a/extra/curses/listener/summary.txt b/extra/curses/listener/summary.txt
new file mode 100644 (file)
index 0000000..823c7e4
--- /dev/null
@@ -0,0 +1 @@
+A curses-based Factor listener.