From 532010a67360001ba94786ba0dc0b18cd96ef40b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Br=C3=BCschweiler?= Date: Thu, 25 Feb 2010 23:15:11 +0100 Subject: [PATCH] curses.listener: very basic curses-based listener --- extra/curses/listener/authors.txt | 1 + extra/curses/listener/listener.factor | 64 +++++++++++++++++++++++++++ extra/curses/listener/platforms.txt | 1 + extra/curses/listener/summary.txt | 1 + 4 files changed, 67 insertions(+) create mode 100644 extra/curses/listener/authors.txt create mode 100644 extra/curses/listener/listener.factor create mode 100644 extra/curses/listener/platforms.txt create mode 100644 extra/curses/listener/summary.txt diff --git a/extra/curses/listener/authors.txt b/extra/curses/listener/authors.txt new file mode 100644 index 0000000000..4f30515bbb --- /dev/null +++ b/extra/curses/listener/authors.txt @@ -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 index 0000000000..4505c63cbc --- /dev/null +++ b/extra/curses/listener/listener.factor @@ -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-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 index 0000000000..509143d863 --- /dev/null +++ b/extra/curses/listener/platforms.txt @@ -0,0 +1 @@ +unix diff --git a/extra/curses/listener/summary.txt b/extra/curses/listener/summary.txt new file mode 100644 index 0000000000..823c7e4311 --- /dev/null +++ b/extra/curses/listener/summary.txt @@ -0,0 +1 @@ +A curses-based Factor listener.