From f2e5b168a79f25e4a4e3a6cfff217d52f7e462fb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Br=C3=BCschweiler?= Date: Tue, 20 Oct 2009 13:57:24 +0200 Subject: [PATCH 01/18] curses: partial rewrite --- extra/curses/curses-tests.factor | 16 +- extra/curses/curses.factor | 292 +++++++++++++++++++------------ extra/curses/ffi/ffi.factor | 139 +++++++++------ 3 files changed, 270 insertions(+), 177 deletions(-) diff --git a/extra/curses/curses-tests.factor b/extra/curses/curses-tests.factor index bd98a7aff1..d03935630f 100644 --- a/extra/curses/curses-tests.factor +++ b/extra/curses/curses-tests.factor @@ -1,17 +1,17 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors curses kernel threads tools.test ; +USING: accessors calendar curses kernel threads tools.test +strings sequences ; IN: curses.tests : hello-curses ( -- ) - [ - curses-window new - "mainwin" >>name - add-curses-window + [ + "Hello Curses!" [ + dup curses-move curses-addch + ] each-index + curses-refresh - "mainwin" "hi" curses-printf - - 2000000 sleep + 2 seconds sleep ] with-curses ; curses-ok? [ diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index dfb1b8672a..aef0057773 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -1,56 +1,36 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.c-types alien.strings assocs byte-arrays -combinators continuations destructors fry io.encodings.8-bit -io io.encodings.string io.encodings.utf8 kernel locals math -namespaces prettyprint sequences classes.struct -strings threads curses.ffi unix.ffi ; +classes.struct combinators continuations curses.ffi destructors +fry io io.encodings.8-bit io.encodings.string io.encodings.utf8 +io.streams.c kernel libc locals math memoize multiline +namespaces prettyprint sequences strings threads ; IN: curses -SYMBOL: curses-windows SYMBOL: current-window -CONSTANT: ERR -1 -CONSTANT: FALSE 0 -CONSTANT: TRUE 1 -: >BOOLEAN ( n -- TRUE/FALSE ) >boolean TRUE FALSE ? ; inline +CONSTANT: COLOR_BLACK 0 +CONSTANT: COLOR_RED 1 +CONSTANT: COLOR_GREEN 2 +CONSTANT: COLOR_YELLO 3 +CONSTANT: COLOR_BLUE 4 +CONSTANT: COLOR_MAGEN 5 +CONSTANT: COLOR_CYAN 6 +CONSTANT: COLOR_WHITE 7 + +: >BOOLEAN ( ? -- TRUE/FALSE ) TRUE FALSE ? ; inline -ERROR: duplicate-window window ; -ERROR: unnamed-window window ; -ERROR: window-not-found window ; ERROR: curses-failed ; ERROR: unsupported-curses-terminal ; -: get-window ( string -- window ) - dup curses-windows get at* - [ nip ] [ drop window-not-found ] if ; - -: window-ptr ( string -- window ) get-window ptr>> ; - : curses-error ( n -- ) ERR = [ curses-failed ] when ; : curses-ok? ( -- ? ) { 0 1 2 } [ isatty 0 = not ] all? ; -: with-curses ( quot -- ) - curses-ok? [ unsupported-curses-terminal ] unless - H{ } clone curses-windows [ - initscr curses-error - [ - curses-windows get values [ dispose ] each - nocbreak curses-error - echo curses-error - endwin curses-error - ] [ ] cleanup - ] with-variable ; inline - -: with-window ( name quot -- ) - [ window-ptr current-window ] dip with-variable ; inline - -TUPLE: curses-window - name - parent-name +TUPLE: curses-window < disposable ptr + parent-window { lines integer initial: 0 } { columns integer initial: 0 } { y integer initial: 0 } @@ -64,99 +44,189 @@ TUPLE: curses-window { leaveok initial: f } idcok idlok immedok - { keypad initial: f } ; + { keypad initial: t } -M: curses-window dispose ( window -- ) + { encoding initial: utf8 } ; + +: ( -- window ) + curses-window new-disposable ; + +M: curses-window dispose* ( window -- ) ptr>> delwin curses-error ; > [ unnamed-window ] unless* - curses-windows get 2dup key? - [ duplicate-window ] [ set-at ] if ; - -: delete-window ( window -- ) - curses-windows get 2dup key? - [ delete-at ] [ drop window-not-found ] if ; - : window-params ( window -- lines columns y x ) { [ lines>> ] [ columns>> ] [ y>> ] [ x>> ] } cleave ; -: setup-window ( window -- ) +: set-cbreak/raw ( cbreak raw -- ) + [ drop raw ] [ + [ cbreak ] [ nocbreak ] if + ] if curses-error ; + +: apply-options ( window -- ) { - [ - dup - dup parent-name>> [ - window-ptr swap window-params derwin - ] [ - window-params newwin - ] if* [ curses-error ] keep >>ptr drop - ] - [ cbreak>> [ cbreak ] [ nocbreak ] if curses-error ] + [ [ cbreak>> ] [ raw>> ] bi set-cbreak/raw ] [ echo>> [ echo ] [ noecho ] if curses-error ] - [ raw>> [ raw ] [ noraw ] if curses-error ] [ [ ptr>> ] [ scrollok>> >BOOLEAN ] bi scrollok curses-error ] [ [ ptr>> ] [ leaveok>> >BOOLEAN ] bi leaveok curses-error ] [ [ ptr>> ] [ keypad>> >BOOLEAN ] bi keypad curses-error ] - [ add-window ] } cleave ; +SYMBOL: n-registered-colors + +MEMO: register-color ( fg bg -- n ) + [ n-registered-colors get ] 2dip init_pair curses-error + n-registered-colors [ get ] [ inc ] bi ; + PRIVATE> -: add-curses-window ( window -- ) - [ setup-window ] [ ] [ dispose ] cleanup ; - -: (curses-window-refresh) ( window-ptr -- ) wrefresh curses-error ; -: wnrefresh ( window -- ) window-ptr (curses-window-refresh) ; -: curses-refresh ( -- ) current-window get (curses-window-refresh) ; - -: (curses-wprint) ( window-ptr string -- ) - waddstr curses-error ; - -: curses-nwrite ( window string -- ) - [ window-ptr ] dip (curses-wprint) ; - -: curses-wprint ( window string -- ) - [ window-ptr dup ] dip (curses-wprint) "\n" (curses-wprint) ; - -: curses-printf ( window string -- ) - [ window-ptr dup dup ] dip (curses-wprint) - "\n" (curses-wprint) - (curses-window-refresh) ; - -: curses-writef ( window string -- ) - [ window-ptr dup ] dip (curses-wprint) (curses-window-refresh) ; - -:: (curses-read) ( window-ptr n encoding -- string ) - n :> buf - window-ptr buf n wgetnstr curses-error - buf encoding alien>string ; - -: curses-read ( window n -- string ) - utf8 [ window-ptr ] 2dip (curses-read) ; - -: curses-erase ( window -- ) window-ptr werase curses-error ; - -: move-cursor ( window-name y x -- ) +: setup-window ( window -- window ) [ - window-ptr c-window memory>struct - { - [ ] - [ (curses-window-refresh) ] - [ _curx>> ] - [ _cury>> ] - } cleave - ] 2dip mvcur curses-error (curses-window-refresh) ; + dup + dup parent-window>> [ + ptr>> swap window-params derwin + ] [ + window-params newwin + ] if* [ curses-error ] keep >>ptr &dispose + ] [ apply-options ] bi ; -: delete-line ( window-name y -- ) - [ window-ptr dup ] dip - 0 wmove curses-error wdeleteln curses-error ; +: with-window ( window quot -- ) + [ current-window ] dip with-variable ; inline -: insert-blank-line ( window-name y -- ) - [ window-ptr dup ] dip - 0 wmove curses-error winsertln curses-error ; + + +: with-curses ( window quot -- ) + curses-ok? [ unsupported-curses-terminal ] unless + [ + [ + initscr curses-pointer-error + >>ptr dup apply-options + ] dip + erase curses-error + init-colors + [ + [ endwin curses-error ] [ ] cleanup + ] curry with-window + ] with-destructors ; inline + + + str + window-ptr str n wgetnstr curses-error + str encoding alien>string + ] with-destructors ; inline + +: (window-curses-getch) ( window -- key ) + wgetch [ curses-error ] keep ; + +: (window-curses-move) ( y x window-ptr -- ) + -rot wmove curses-error ; inline + +: (window-insert-blank-line) ( y window-ptr -- ) + [ 0 swap (window-curses-move) ] + [ winsertln curses-error ] bi ; inline + +: (window-curses-addch) ( ch window-ptr -- ) + swap waddch curses-error ; inline + +PRIVATE> + +: window-curses-refresh ( window -- ) ptr>> (window-curses-refresh) ; +: curses-refresh ( -- ) current-window get window-curses-refresh ; + +: window-curses-write ( string window -- ) + ptr>> (window-curses-write) ; +: curses-write ( string -- ) + current-window get window-curses-write ; + +: window-curses-nl ( window -- ) + [ "\n" ] dip ptr>> (window-curses-write) ; +: curses-nl ( -- ) + current-window get window-curses-nl ; + +: window-curses-print ( string window -- ) + ptr>> [ (window-curses-write) ] + [ "\n" swap (window-curses-write) ] bi ; +: curses-print ( string -- ) + current-window get window-curses-print ; + +: window-curses-print-refresh ( string window -- ) + ptr>> [ (window-curses-write) ] + [ "\n" swap (window-curses-write) ] + [ (window-curses-refresh) ] tri ; +: curses-print-refresh ( string -- ) + current-window get window-curses-print-refresh ; + +: window-curses-write-refresh ( string window -- ) + ptr>> [ (window-curses-write) ] [ (window-curses-refresh) ] bi ; +: curses-write-refresh ( string -- ) + current-window get window-curses-write-refresh ; + +: window-curses-read ( n window -- string ) + [ encoding>> ] [ ptr>> ] bi (window-curses-read) ; +: curses-read ( n -- string ) + current-window get window-curses-read ; + +: window-curses-getch ( window -- key ) + ptr>> (window-curses-getch) ; +: curses-getch ( -- key ) + current-window get window-curses-getch ; + +: window-curses-erase ( window -- ) + ptr>> werase curses-error ; +: curses-erase ( -- ) + current-window get window-curses-erase ; + +: window-curses-move ( y x window -- ) + ptr>> [ (window-curses-move) ] [ (window-curses-refresh) ] bi ; +: curses-move ( y x -- ) + current-window get window-curses-move ; + +: window-delete-line ( y window -- ) + ptr>> [ 0 swap (window-curses-move) ] + [ wdeleteln curses-error ] bi ; +: delete-line ( y -- ) + current-window get window-delete-line ; + +: window-insert-blank-line ( y window -- ) + ptr>> (window-insert-blank-line) ; +: insert-blank-line ( y -- ) + current-window get window-insert-blank-line ; + +: window-insert-line ( string y window -- ) + ptr>> [ (window-insert-blank-line) ] + [ (window-curses-write) ] bi ; +: insert-line ( string y -- ) + current-window get window-insert-line ; + +: window-curses-addch ( ch window -- ) + ptr>> (window-curses-addch) ; +: curses-addch ( ch -- ) + current-window get window-curses-addch ; + +: window-curses-color ( foreground background window -- ) + [ + 2dup [ COLOR_WHITE = ] [ COLOR_BLACK = ] bi* and + [ 2drop 0 ] [ register-color ] if COLOR_PAIR + ] dip ptr>> swap wattron curses-error ; +: curses-color ( foreground background -- ) + current-window get window-curses-color ; diff --git a/extra/curses/ffi/ffi.factor b/extra/curses/ffi/ffi.factor index 2b52d0ec56..591c8c820a 100644 --- a/extra/curses/ffi/ffi.factor +++ b/extra/curses/ffi/ffi.factor @@ -1,13 +1,13 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien alien.syntax combinators kernel system -alien.c-types alien.libraries classes.struct unix.types ; +USING: accessors alien alien.c-types alien.libraries +alien.syntax classes.struct combinators kernel math system unix.types ; IN: curses.ffi << "curses" { { [ os winnt? ] [ "libcurses.dll" ] } { [ os macosx? ] [ "libcurses.dylib" ] } - { [ os unix? ] [ "libcurses.so" ] } + { [ os unix? ] [ "libncurses.so.5.7" ] } } cond cdecl add-library >> C-TYPE: WINDOW @@ -21,56 +21,60 @@ TYPEDEF: ushort wchar_t CONSTANT: CCHARW_MAX 5 +CONSTANT: ERR -1 +CONSTANT: FALSE 0 +CONSTANT: TRUE 1 + STRUCT: cchar_t - { attr attr_t } - { chars { wchar_t CCHARW_MAX } } ; +{ attr attr_t } +{ chars { wchar_t CCHARW_MAX } } ; STRUCT: pdat - { _pad_y NCURSES_SIZE_T } - { _pad_x NCURSES_SIZE_T } - { _pad_top NCURSES_SIZE_T } - { _pad_left NCURSES_SIZE_T } - { _pad_bottom NCURSES_SIZE_T } - { _pad_right NCURSES_SIZE_T } ; +{ _pad_y NCURSES_SIZE_T } +{ _pad_x NCURSES_SIZE_T } +{ _pad_top NCURSES_SIZE_T } +{ _pad_left NCURSES_SIZE_T } +{ _pad_bottom NCURSES_SIZE_T } +{ _pad_right NCURSES_SIZE_T } ; STRUCT: c-window - { _cury NCURSES_SIZE_T } - { _curx NCURSES_SIZE_T } +{ _cury NCURSES_SIZE_T } +{ _curx NCURSES_SIZE_T } - { _maxy NCURSES_SIZE_T } - { _maxx NCURSES_SIZE_T } - { _begy NCURSES_SIZE_T } - { _begx NCURSES_SIZE_T } +{ _maxy NCURSES_SIZE_T } +{ _maxx NCURSES_SIZE_T } +{ _begy NCURSES_SIZE_T } +{ _begx NCURSES_SIZE_T } - { _flags short } +{ _flags short } - { _attrs attr_t } - { _bkgd chtype } +{ _attrs attr_t } +{ _bkgd chtype } - { _notimeout bool } - { _clear bool } - { _leaveok bool } - { _scroll bool } - { _idlok bool } - { _idcok bool } - { _immed bool } - { _sync bool } - { _use_keypad bool } - { _delay int } +{ _notimeout bool } +{ _clear bool } +{ _leaveok bool } +{ _scroll bool } +{ _idlok bool } +{ _idcok bool } +{ _immed bool } +{ _sync bool } +{ _use_keypad bool } +{ _delay int } - { _line c-string } - { _regtop NCURSES_SIZE_T } - { _regbottom NCURSES_SIZE_T } +{ _line c-string } +{ _regtop NCURSES_SIZE_T } +{ _regbottom NCURSES_SIZE_T } - { _parx int } - { _pary int } - { _parent WINDOW* } +{ _parx int } +{ _pary int } +{ _parent WINDOW* } - { _pad pdat } +{ _pad pdat } - { _yoffset NCURSES_SIZE_T } +{ _yoffset NCURSES_SIZE_T } - { _bkgrnd cchar_t } ; +{ _bkgrnd cchar_t } ; LIBRARY: curses @@ -134,13 +138,13 @@ FUNCTION: int scrollok ( WINDOW* win, bool bf ) ; FUNCTION: int nl ( ) ; FUNCTION: int nonl ( ) ; -FUNCTION: int erase ( ) ; +FUNCTION: int erase ( ) ; FUNCTION: int werase ( WINDOW* win ) ; -FUNCTION: int clear ( ) ; +FUNCTION: int clear ( ) ; FUNCTION: int wclear ( WINDOW* win ) ; -FUNCTION: int clrtobot ( ) ; +FUNCTION: int clrtobot ( ) ; FUNCTION: int wclrtobot ( WINDOW* win ) ; -FUNCTION: int clrtoeol ( ) ; +FUNCTION: int clrtoeol ( ) ; FUNCTION: int wclrtoeol ( WINDOW* win ) ; FUNCTION: int refresh ( ) ; @@ -181,22 +185,22 @@ FUNCTION: int scroll ( WINDOW* win ) ; FUNCTION: int scrl ( int n ) ; FUNCTION: int wscrl ( WINDOW* win, int n ) ; - ! int setupterm(char *term, int fildes, int *errret); - ! int setterm(char *term); - ! TERMINAL *set_curterm(TERMINAL *nterm); - ! int del_curterm(TERMINAL *oterm); - ! int restartterm(const char *term, int fildes, int *errret); - ! char *tparm(char *str, ...); - ! int tputs(const char *str, int affcnt, int (*putc)(int)); - ! int putp(const char *str); - ! int vidputs(chtype attrs, int (*putc)(int)); - ! int vidattr(chtype attrs); - ! int vid_puts(attr_t attrs, short pair, void *opts, int (*putc)(char)); - ! int vid_attr(attr_t attrs, short pair, void *opts); +! int setupterm(char *term, int fildes, int *errret); +! int setterm(char *term); +! TERMINAL *set_curterm(TERMINAL *nterm); +! int del_curterm(TERMINAL *oterm); +! int restartterm(const char *term, int fildes, int *errret); +! char *tparm(char *str, ...); +! int tputs(const char *str, int affcnt, int (*putc)(int)); +! int putp(const char *str); +! int vidputs(chtype attrs, int (*putc)(int)); +! int vidattr(chtype attrs); +! int vid_puts(attr_t attrs, short pair, void *opts, int (*putc)(char)); +! int vid_attr(attr_t attrs, short pair, void *opts); FUNCTION: int mvcur ( int oldrow, int oldcol, int newrow, int newcol ) ; - ! int tigetflag(char *capname); - ! int tigetnum(char *capname); - ! char *tigetstr(char *capname); +! int tigetflag(char *capname); +! int tigetnum(char *capname); +! char *tigetstr(char *capname); FUNCTION: int touchwin ( WINDOW* win ) ; FUNCTION: int touchline ( WINDOW* win, int start, int count ) ; @@ -229,3 +233,22 @@ FUNCTION: int mvaddstr ( int y, int x, c-string str ) ; FUNCTION: int mvaddnstr ( int y, int x, c-string str, int n ) ; FUNCTION: int mvwaddstr ( WINDOW* win, int y, int x, c-string str ) ; FUNCTION: int mvwaddnstr ( WINDOW* win, int y, int x, c-string str, int n ) ; + +FUNCTION: int waddch ( WINDOW* win, chtype ch ) ; + +FUNCTION: int start_color ( ) ; +FUNCTION: int init_pair ( short pair, short f, short b ) ; +FUNCTION: int init_color ( short color, short r, short g, short b ) ; +FUNCTION: bool has_colors ( ) ; +FUNCTION: bool can_change_color ( ) ; +FUNCTION: int color_content ( short color, short* r, short* g, short* b ) ; +FUNCTION: int pair_content ( short pair, short* f, short* b ) ; + +C-GLOBAL: int COLORS +C-GLOBAL: int COLOR_PAIRS + +: COLOR_PAIR ( n -- n' ) 8 shift ; inline foldable + +FUNCTION: int wattron ( WINDOW* win, int attrs ) ; +FUNCTION: int wattroff ( WINDOW* win, int attrs ) ; +FUNCTION: int wattrset ( WINDOW* win, int attrs ) ; From 717f036e52767cd2360596b7a7a450827ef06302 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Br=C3=BCschweiler?= Date: Tue, 20 Oct 2009 13:58:19 +0200 Subject: [PATCH 02/18] curses: beginning of screen support --- extra/curses/curses.factor | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index aef0057773..78ff542ff9 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -121,6 +121,30 @@ PRIVATE> [ endwin curses-error ] [ ] cleanup ] curry with-window ] with-destructors ; inline + +TUPLE: curses-terminal < disposable + infd outfd ptr ; + +: ( infd outfd ptr -- curses-terminal ) + curses-terminal new-disposable + swap >>ptr + swap >>outfd + swap >>infd ; + +M: curses-terminal dispose + [ outfd>> fclose ] [ infd>> fclose ] + [ ptr>> delscreen ] tri ; + +: init-terminal ( terminal -- curses-terminal ) + "xterm-color" swap [ "rb" fopen ] [ "wb" fopen ] bi + [ newterm curses-pointer-error ] 2keep ; + +: start-remote-curses ( terminal window -- curses-terminal ) + [ + init-terminal + initscr curses-pointer-error drop + dup ptr>> set_term curses-pointer-error drop + ] dip apply-options ; Date: Wed, 21 Oct 2009 17:09:24 +0200 Subject: [PATCH 03/18] curses: renamed to shorter words --- extra/curses/curses.factor | 205 +++++++++++++++++-------------------- 1 file changed, 93 insertions(+), 112 deletions(-) diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index 78ff542ff9..5a361f891f 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -1,12 +1,14 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.c-types alien.strings assocs byte-arrays -classes.struct combinators continuations curses.ffi destructors +classes.struct combinators continuations destructors fry io io.encodings.8-bit io.encodings.string io.encodings.utf8 io.streams.c kernel libc locals math memoize multiline namespaces prettyprint sequences strings threads ; IN: curses +QUALIFIED-WITH: curses.ffi ffi + SYMBOL: current-window CONSTANT: COLOR_BLACK 0 @@ -18,12 +20,18 @@ CONSTANT: COLOR_MAGEN 5 CONSTANT: COLOR_CYAN 6 CONSTANT: COLOR_WHITE 7 -: >BOOLEAN ( ? -- TRUE/FALSE ) TRUE FALSE ? ; inline - ERROR: curses-failed ; ERROR: unsupported-curses-terminal ; -: curses-error ( n -- ) ERR = [ curses-failed ] when ; +BOOLEAN ( ? -- TRUE/FALSE ) ffi:TRUE ffi:FALSE ? ; inline + +: curses-pointer-error ( ptr/f -- ptr ) + dup [ curses-failed ] unless ; inline +: curses-error ( n -- ) ffi:ERR = [ curses-failed ] when ; + +PRIVATE> : curses-ok? ( -- ? ) { 0 1 2 } [ isatty 0 = not ] all? ; @@ -52,7 +60,7 @@ TUPLE: curses-window < disposable curses-window new-disposable ; M: curses-window dispose* ( window -- ) - ptr>> delwin curses-error ; + ptr>> ffi:delwin curses-error ; > ] [ columns>> ] [ y>> ] [ x>> ] } cleave ; : set-cbreak/raw ( cbreak raw -- ) - [ drop raw ] [ - [ cbreak ] [ nocbreak ] if + [ drop ffi:raw ] [ + [ ffi:cbreak ] [ ffi:nocbreak ] if ] if curses-error ; : apply-options ( window -- ) { [ [ cbreak>> ] [ raw>> ] bi set-cbreak/raw ] - [ echo>> [ echo ] [ noecho ] if curses-error ] - [ [ ptr>> ] [ scrollok>> >BOOLEAN ] bi scrollok curses-error ] - [ [ ptr>> ] [ leaveok>> >BOOLEAN ] bi leaveok curses-error ] - [ [ ptr>> ] [ keypad>> >BOOLEAN ] bi keypad curses-error ] + [ echo>> [ ffi:echo ] [ ffi:noecho ] if curses-error ] + [ [ ptr>> ] [ scrollok>> >BOOLEAN ] bi ffi:scrollok curses-error ] + [ [ ptr>> ] [ leaveok>> >BOOLEAN ] bi ffi:leaveok curses-error ] + [ [ ptr>> ] [ keypad>> >BOOLEAN ] bi ffi:keypad curses-error ] } cleave ; SYMBOL: n-registered-colors MEMO: register-color ( fg bg -- n ) - [ n-registered-colors get ] 2dip init_pair curses-error + [ n-registered-colors get ] 2dip ffi:init_pair curses-error n-registered-colors [ get ] [ inc ] bi ; +: init-colors ( -- ) + ffi:has_colors [ + 1 n-registered-colors set + \ register-color reset-memoized + ffi:start_color curses-error + ] when ; + PRIVATE> : setup-window ( window -- window ) [ dup dup parent-window>> [ - ptr>> swap window-params derwin + ptr>> swap window-params ffi:derwin ] [ - window-params newwin + window-params ffi:newwin ] if* [ curses-error ] keep >>ptr &dispose ] [ apply-options ] bi ; : with-window ( window quot -- ) [ current-window ] dip with-variable ; inline - - : with-curses ( window quot -- ) curses-ok? [ unsupported-curses-terminal ] unless [ [ - initscr curses-pointer-error + ffi:initscr curses-pointer-error >>ptr dup apply-options ] dip - erase curses-error + ffi:erase curses-error init-colors [ - [ endwin curses-error ] [ ] cleanup + [ ffi:endwin curses-error ] [ ] cleanup ] curry with-window ] with-destructors ; inline @@ -133,124 +134,104 @@ TUPLE: curses-terminal < disposable M: curses-terminal dispose [ outfd>> fclose ] [ infd>> fclose ] - [ ptr>> delscreen ] tri ; + [ ptr>> ffi:delscreen ] tri ; : init-terminal ( terminal -- curses-terminal ) "xterm-color" swap [ "rb" fopen ] [ "wb" fopen ] bi - [ newterm curses-pointer-error ] 2keep ; + [ ffi:newterm curses-pointer-error ] 2keep ; : start-remote-curses ( terminal window -- curses-terminal ) [ init-terminal - initscr curses-pointer-error drop - dup ptr>> set_term curses-pointer-error drop + ffi:initscr curses-pointer-error drop + dup ptr>> ffi:set_term curses-pointer-error drop ] dip apply-options ; - str - window-ptr str n wgetnstr curses-error + window-ptr str n ffi:wgetnstr curses-error str encoding alien>string ] with-destructors ; inline -: (window-curses-getch) ( window -- key ) - wgetch [ curses-error ] keep ; +: (wcmove) ( y x window-ptr -- ) + -rot ffi:wmove curses-error ; inline -: (window-curses-move) ( y x window-ptr -- ) - -rot wmove curses-error ; inline +: (winsert-blank-line) ( y window-ptr -- ) + [ 0 swap (wcmove) ] + [ ffi:winsertln curses-error ] bi ; inline -: (window-insert-blank-line) ( y window-ptr -- ) - [ 0 swap (window-curses-move) ] - [ winsertln curses-error ] bi ; inline +: (waddch) ( ch window-ptr -- ) + swap ffi:waddch curses-error ; inline -: (window-curses-addch) ( ch window-ptr -- ) - swap waddch curses-error ; inline +: (wgetch) ( window -- key ) + ffi:wgetch [ curses-error ] keep ; inline PRIVATE> -: window-curses-refresh ( window -- ) ptr>> (window-curses-refresh) ; -: curses-refresh ( -- ) current-window get window-curses-refresh ; +: wcrefresh ( window -- ) ptr>> (wcrefresh) ; +: crefresh ( -- ) current-window get wcrefresh ; -: window-curses-write ( string window -- ) - ptr>> (window-curses-write) ; -: curses-write ( string -- ) - current-window get window-curses-write ; +: wcwrite ( string window -- ) ptr>> (wcwrite) ; +: cwrite ( string -- ) current-window get wcwrite ; -: window-curses-nl ( window -- ) - [ "\n" ] dip ptr>> (window-curses-write) ; -: curses-nl ( -- ) - current-window get window-curses-nl ; +: wcnl ( window -- ) [ "\n" ] dip ptr>> (wcwrite) ; +: cnl ( -- ) current-window get wcnl ; -: window-curses-print ( string window -- ) - ptr>> [ (window-curses-write) ] - [ "\n" swap (window-curses-write) ] bi ; -: curses-print ( string -- ) - current-window get window-curses-print ; +: wcprint ( string window -- ) + ptr>> [ (wcwrite) ] [ "\n" swap (wcwrite) ] bi ; +: cprint ( string -- ) current-window get wcprint ; -: window-curses-print-refresh ( string window -- ) - ptr>> [ (window-curses-write) ] - [ "\n" swap (window-curses-write) ] - [ (window-curses-refresh) ] tri ; -: curses-print-refresh ( string -- ) - current-window get window-curses-print-refresh ; +: wcprintf ( string window -- ) + ptr>> [ (wcwrite) ] [ "\n" swap (wcwrite) ] + [ (wcrefresh) ] tri ; +: curses-print-refresh ( string -- ) current-window get wcprintf ; -: window-curses-write-refresh ( string window -- ) - ptr>> [ (window-curses-write) ] [ (window-curses-refresh) ] bi ; -: curses-write-refresh ( string -- ) - current-window get window-curses-write-refresh ; +: wcwritef ( string window -- ) + ptr>> [ (wcwrite) ] [ (wcrefresh) ] bi ; +: cwritef ( string -- ) current-window get wcwritef ; -: window-curses-read ( n window -- string ) - [ encoding>> ] [ ptr>> ] bi (window-curses-read) ; -: curses-read ( n -- string ) - current-window get window-curses-read ; +: wcread ( n window -- string ) + [ encoding>> ] [ ptr>> ] bi (wcread) ; +: curses-read ( n -- string ) current-window get wcread ; -: window-curses-getch ( window -- key ) - ptr>> (window-curses-getch) ; -: curses-getch ( -- key ) - current-window get window-curses-getch ; +: wgetch ( window -- key ) ptr>> (wgetch) ; +: getch ( -- key ) current-window get wgetch ; -: window-curses-erase ( window -- ) - ptr>> werase curses-error ; -: curses-erase ( -- ) - current-window get window-curses-erase ; +: waddch ( ch window -- ) ptr>> (waddch) ; +: addch ( ch -- ) current-window get waddch ; -: window-curses-move ( y x window -- ) - ptr>> [ (window-curses-move) ] [ (window-curses-refresh) ] bi ; -: curses-move ( y x -- ) - current-window get window-curses-move ; +: werase ( window -- ) ptr>> ffi:werase curses-error ; +: erase ( -- ) current-window get werase ; -: window-delete-line ( y window -- ) - ptr>> [ 0 swap (window-curses-move) ] - [ wdeleteln curses-error ] bi ; -: delete-line ( y -- ) - current-window get window-delete-line ; +: wcmove ( y x window -- ) + ptr>> [ (wcmove) ] [ (wcrefresh) ] bi ; +: cmove ( y x -- ) current-window get wcmove ; -: window-insert-blank-line ( y window -- ) - ptr>> (window-insert-blank-line) ; +: wdelete-line ( y window -- ) + ptr>> [ 0 swap (wcmove) ] [ ffi:wdeleteln curses-error ] bi ; +: delete-line ( y -- ) current-window get wdelete-line ; + +: winsert-blank-line ( y window -- ) + ptr>> (winsert-blank-line) ; : insert-blank-line ( y -- ) - current-window get window-insert-blank-line ; + current-window get winsert-blank-line ; -: window-insert-line ( string y window -- ) - ptr>> [ (window-insert-blank-line) ] - [ (window-curses-write) ] bi ; +: winsert-line ( string y window -- ) + ptr>> [ (winsert-blank-line) ] [ (wcwrite) ] bi ; : insert-line ( string y -- ) - current-window get window-insert-line ; + current-window get winsert-line ; -: window-curses-addch ( ch window -- ) - ptr>> (window-curses-addch) ; -: curses-addch ( ch -- ) - current-window get window-curses-addch ; - -: window-curses-color ( foreground background window -- ) +: wccolor ( foreground background window -- ) [ 2dup [ COLOR_WHITE = ] [ COLOR_BLACK = ] bi* and - [ 2drop 0 ] [ register-color ] if COLOR_PAIR - ] dip ptr>> swap wattron curses-error ; -: curses-color ( foreground background -- ) - current-window get window-curses-color ; + [ 2drop 0 ] [ register-color ] if ffi:COLOR_PAIR + ] dip ptr>> swap ffi:wattron curses-error ; + +: ccolor ( foreground background -- ) + current-window get wccolor ; From 0e9572bf85875f84c687308eb733e885cc4c5621 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Br=C3=BCschweiler?= Date: Wed, 21 Oct 2009 17:10:56 +0200 Subject: [PATCH 04/18] curses: fix test --- extra/curses/curses-tests.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/curses/curses-tests.factor b/extra/curses/curses-tests.factor index d03935630f..a56f067911 100644 --- a/extra/curses/curses-tests.factor +++ b/extra/curses/curses-tests.factor @@ -7,9 +7,9 @@ IN: curses.tests : hello-curses ( -- ) [ "Hello Curses!" [ - dup curses-move curses-addch + dup cmove addch ] each-index - curses-refresh + crefresh 2 seconds sleep ] with-curses ; From 697d8469129067fa3ef2d10f112b4617732452c6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Br=C3=BCschweiler?= Date: Wed, 21 Oct 2009 19:36:41 +0200 Subject: [PATCH 05/18] curses: add attributes --- extra/curses/curses.factor | 57 ++++++++++++++++++++++++++++++-------- 1 file changed, 45 insertions(+), 12 deletions(-) diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index 5a361f891f..bb1ff1f201 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -20,6 +20,26 @@ CONSTANT: COLOR_MAGEN 5 CONSTANT: COLOR_CYAN 6 CONSTANT: COLOR_WHITE 7 +CONSTANT: A_NORMAL 0 +CONSTANT: A_ATTRIBUTES -256 +CONSTANT: A_CHARTEXT 255 +CONSTANT: A_COLOR 65280 +CONSTANT: A_STANDOUT 65536 +CONSTANT: A_UNDERLINE 131072 +CONSTANT: A_REVERSE 262144 +CONSTANT: A_BLINK 524288 +CONSTANT: A_DIM 1048576 +CONSTANT: A_BOLD 2097152 +CONSTANT: A_ALTCHARSET 4194304 +CONSTANT: A_INVIS 8388608 +CONSTANT: A_PROTECT 16777216 +CONSTANT: A_HORIZONTAL 33554432 +CONSTANT: A_LEFT 67108864 +CONSTANT: A_LOW 134217728 +CONSTANT: A_RIGHT 268435456 +CONSTANT: A_TOP 536870912 +CONSTANT: A_VERTICAL 1073741824 + ERROR: curses-failed ; ERROR: unsupported-curses-terminal ; @@ -112,15 +132,13 @@ PRIVATE> : with-curses ( window quot -- ) curses-ok? [ unsupported-curses-terminal ] unless [ - [ + '[ ffi:initscr curses-pointer-error >>ptr dup apply-options - ] dip - ffi:erase curses-error - init-colors - [ - [ ffi:endwin curses-error ] [ ] cleanup - ] curry with-window + ffi:erase curses-error + init-colors + _ with-window + ] [ ffi:endwin curses-error ] [ ] cleanup ] with-destructors ; inline TUPLE: curses-terminal < disposable @@ -172,17 +190,23 @@ M: curses-terminal dispose : (wgetch) ( window -- key ) ffi:wgetch [ curses-error ] keep ; inline +: (wattroff) ( attribute window-ptr -- ) + swap ffi:wattroff curses-error ; inline + +: (wattron) ( attribute window-ptr -- ) + swap ffi:wattron curses-error ; inline + PRIVATE> : wcrefresh ( window -- ) ptr>> (wcrefresh) ; : crefresh ( -- ) current-window get wcrefresh ; -: wcwrite ( string window -- ) ptr>> (wcwrite) ; -: cwrite ( string -- ) current-window get wcwrite ; - : wcnl ( window -- ) [ "\n" ] dip ptr>> (wcwrite) ; : cnl ( -- ) current-window get wcnl ; +: wcwrite ( string window -- ) ptr>> (wcwrite) ; +: cwrite ( string -- ) current-window get wcwrite ; + : wcprint ( string window -- ) ptr>> [ (wcwrite) ] [ "\n" swap (wcwrite) ] bi ; : cprint ( string -- ) current-window get wcprint ; @@ -190,7 +214,7 @@ PRIVATE> : wcprintf ( string window -- ) ptr>> [ (wcwrite) ] [ "\n" swap (wcwrite) ] [ (wcrefresh) ] tri ; -: curses-print-refresh ( string -- ) current-window get wcprintf ; +: cprintf ( string -- ) current-window get wcprintf ; : wcwritef ( string window -- ) ptr>> [ (wcwrite) ] [ (wcrefresh) ] bi ; @@ -227,11 +251,20 @@ PRIVATE> : insert-line ( string y -- ) current-window get winsert-line ; +: wattron ( attribute window -- ) ptr>> (wattron) ; +: attron ( attribute -- ) current-window get wattron ; + +: wattroff ( attribute window -- ) ptr>> (wattroff) ; +: attroff ( attribute -- ) current-window get wattroff ; + +: wall-attroff ( window -- ) [ A_NORMAL ] dip wattroff ; +: all-attroff ( -- ) current-window get wall-attroff ; + : wccolor ( foreground background window -- ) [ 2dup [ COLOR_WHITE = ] [ COLOR_BLACK = ] bi* and [ 2drop 0 ] [ register-color ] if ffi:COLOR_PAIR - ] dip ptr>> swap ffi:wattron curses-error ; + ] dip ptr>> (wattron) ; : ccolor ( foreground background -- ) current-window get wccolor ; From 52af3100556fd80bca617fb7bdb10e2966e39078 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Br=C3=BCschweiler?= Date: Wed, 21 Oct 2009 20:15:16 +0200 Subject: [PATCH 06/18] curses: added key codes --- extra/curses/curses.factor | 96 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 96 insertions(+) diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index bb1ff1f201..364d4fae32 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -40,6 +40,102 @@ CONSTANT: A_RIGHT 268435456 CONSTANT: A_TOP 536870912 CONSTANT: A_VERTICAL 1073741824 +CONSTANT: KEY_CODE_YES OCT: 400 /* A wchar_t contains a key code */ +CONSTANT: KEY_MIN OCT: 401 /* Minimum curses key */ +CONSTANT: KEY_BREAK OCT: 401 /* Break key (unreliable) */ +CONSTANT: KEY_SRESET OCT: 530 /* Soft (partial) reset (unreliable) */ +CONSTANT: KEY_RESET OCT: 531 /* Reset or hard reset (unreliable) */ +CONSTANT: KEY_DOWN OCT: 402 /* down-arrow key */ +CONSTANT: KEY_UP OCT: 403 /* up-arrow key */ +CONSTANT: KEY_LEFT OCT: 404 /* left-arrow key */ +CONSTANT: KEY_RIGHT OCT: 405 /* right-arrow key */ +CONSTANT: KEY_HOME OCT: 406 /* home key */ +CONSTANT: KEY_BACKSPACE OCT: 407 /* backspace key */ +CONSTANT: KEY_DL OCT: 510 /* delete-line key */ +CONSTANT: KEY_IL OCT: 511 /* insert-line key */ +CONSTANT: KEY_DC OCT: 512 /* delete-character key */ +CONSTANT: KEY_IC OCT: 513 /* insert-character key */ +CONSTANT: KEY_EIC OCT: 514 /* sent by rmir or smir in insert mode */ +CONSTANT: KEY_CLEAR OCT: 515 /* clear-screen or erase key */ +CONSTANT: KEY_EOS OCT: 516 /* clear-to-end-of-screen key */ +CONSTANT: KEY_EOL OCT: 517 /* clear-to-end-of-line key */ +CONSTANT: KEY_SF OCT: 520 /* scroll-forward key */ +CONSTANT: KEY_SR OCT: 521 /* scroll-backward key */ +CONSTANT: KEY_NPAGE OCT: 522 /* next-page key */ +CONSTANT: KEY_PPAGE OCT: 523 /* previous-page key */ +CONSTANT: KEY_STAB OCT: 524 /* set-tab key */ +CONSTANT: KEY_CTAB OCT: 525 /* clear-tab key */ +CONSTANT: KEY_CATAB OCT: 526 /* clear-all-tabs key */ +CONSTANT: KEY_ENTER OCT: 527 /* enter/send key */ +CONSTANT: KEY_PRINT OCT: 532 /* print key */ +CONSTANT: KEY_LL OCT: 533 /* lower-left key (home down) */ +CONSTANT: KEY_A1 OCT: 534 /* upper left of keypad */ +CONSTANT: KEY_A3 OCT: 535 /* upper right of keypad */ +CONSTANT: KEY_B2 OCT: 536 /* center of keypad */ +CONSTANT: KEY_C1 OCT: 537 /* lower left of keypad */ +CONSTANT: KEY_C3 OCT: 540 /* lower right of keypad */ +CONSTANT: KEY_BTAB OCT: 541 /* back-tab key */ +CONSTANT: KEY_BEG OCT: 542 /* begin key */ +CONSTANT: KEY_CANCEL OCT: 543 /* cancel key */ +CONSTANT: KEY_CLOSE OCT: 544 /* close key */ +CONSTANT: KEY_COMMAND OCT: 545 /* command key */ +CONSTANT: KEY_COPY OCT: 546 /* copy key */ +CONSTANT: KEY_CREATE OCT: 547 /* create key */ +CONSTANT: KEY_END OCT: 550 /* end key */ +CONSTANT: KEY_EXIT OCT: 551 /* exit key */ +CONSTANT: KEY_FIND OCT: 552 /* find key */ +CONSTANT: KEY_HELP OCT: 553 /* help key */ +CONSTANT: KEY_MARK OCT: 554 /* mark key */ +CONSTANT: KEY_MESSAGE OCT: 555 /* message key */ +CONSTANT: KEY_MOVE OCT: 556 /* move key */ +CONSTANT: KEY_NEXT OCT: 557 /* next key */ +CONSTANT: KEY_OPEN OCT: 560 /* open key */ +CONSTANT: KEY_OPTIONS OCT: 561 /* options key */ +CONSTANT: KEY_PREVIOUS OCT: 562 /* previous key */ +CONSTANT: KEY_REDO OCT: 563 /* redo key */ +CONSTANT: KEY_REFERENCE OCT: 564 /* reference key */ +CONSTANT: KEY_REFRESH OCT: 565 /* refresh key */ +CONSTANT: KEY_REPLACE OCT: 566 /* replace key */ +CONSTANT: KEY_RESTART OCT: 567 /* restart key */ +CONSTANT: KEY_RESUME OCT: 570 /* resume key */ +CONSTANT: KEY_SAVE OCT: 571 /* save key */ +CONSTANT: KEY_SBEG OCT: 572 /* shifted begin key */ +CONSTANT: KEY_SCANCEL OCT: 573 /* shifted cancel key */ +CONSTANT: KEY_SCOMMAND OCT: 574 /* shifted command key */ +CONSTANT: KEY_SCOPY OCT: 575 /* shifted copy key */ +CONSTANT: KEY_SCREATE OCT: 576 /* shifted create key */ +CONSTANT: KEY_SDC OCT: 577 /* shifted delete-character key */ +CONSTANT: KEY_SDL OCT: 600 /* shifted delete-line key */ +CONSTANT: KEY_SELECT OCT: 601 /* select key */ +CONSTANT: KEY_SEND OCT: 602 /* shifted end key */ +CONSTANT: KEY_SEOL OCT: 603 /* shifted clear-to-end-of-line key */ +CONSTANT: KEY_SEXIT OCT: 604 /* shifted exit key */ +CONSTANT: KEY_SFIND OCT: 605 /* shifted find key */ +CONSTANT: KEY_SHELP OCT: 606 /* shifted help key */ +CONSTANT: KEY_SHOME OCT: 607 /* shifted home key */ +CONSTANT: KEY_SIC OCT: 610 /* shifted insert-character key */ +CONSTANT: KEY_SLEFT OCT: 611 /* shifted left-arrow key */ +CONSTANT: KEY_SMESSAGE OCT: 612 /* shifted message key */ +CONSTANT: KEY_SMOVE OCT: 613 /* shifted move key */ +CONSTANT: KEY_SNEXT OCT: 614 /* shifted next key */ +CONSTANT: KEY_SOPTIONS OCT: 615 /* shifted options key */ +CONSTANT: KEY_SPREVIOUS OCT: 616 /* shifted previous key */ +CONSTANT: KEY_SPRINT OCT: 617 /* shifted print key */ +CONSTANT: KEY_SREDO OCT: 620 /* shifted redo key */ +CONSTANT: KEY_SREPLACE OCT: 621 /* shifted replace key */ +CONSTANT: KEY_SRIGHT OCT: 622 /* shifted right-arrow key */ +CONSTANT: KEY_SRSUME OCT: 623 /* shifted resume key */ +CONSTANT: KEY_SSAVE OCT: 624 /* shifted save key */ +CONSTANT: KEY_SSUSPEND OCT: 625 /* shifted suspend key */ +CONSTANT: KEY_SUNDO OCT: 626 /* shifted undo key */ +CONSTANT: KEY_SUSPEND OCT: 627 /* suspend key */ +CONSTANT: KEY_UNDO OCT: 630 /* undo key */ +CONSTANT: KEY_MOUSE OCT: 631 /* Mouse event has occurred */ +CONSTANT: KEY_RESIZE OCT: 632 /* Terminal resize event */ +CONSTANT: KEY_EVENT OCT: 633 /* We were interrupted by an event */ +CONSTANT: KEY_F0 OCT: 410 /* Function keys. Space for 64 */ +: KEY_F ( n -- code ) KEY_F0 + ; inline /* Value of function key n */ + ERROR: curses-failed ; ERROR: unsupported-curses-terminal ; From e1a9d597b056150f0b6bc8d5260ad9f715d0ba72 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Br=C3=BCschweiler?= Date: Wed, 21 Oct 2009 20:40:32 +0200 Subject: [PATCH 07/18] curses: seperated echo and raw/cbreak options from window-setup --- extra/curses/curses.factor | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index 364d4fae32..895fa52eb7 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -188,15 +188,18 @@ M: curses-window dispose* ( window -- ) [ ffi:cbreak ] [ ffi:nocbreak ] if ] if curses-error ; -: apply-options ( window -- ) +: apply-window-options ( window -- ) { - [ [ cbreak>> ] [ raw>> ] bi set-cbreak/raw ] - [ echo>> [ ffi:echo ] [ ffi:noecho ] if curses-error ] [ [ ptr>> ] [ scrollok>> >BOOLEAN ] bi ffi:scrollok curses-error ] [ [ ptr>> ] [ leaveok>> >BOOLEAN ] bi ffi:leaveok curses-error ] [ [ ptr>> ] [ keypad>> >BOOLEAN ] bi ffi:keypad curses-error ] } cleave ; +: apply-global-options ( window -- ) + [ [ cbreak>> ] [ raw>> ] bi set-cbreak/raw ] + [ echo>> [ ffi:echo ] [ ffi:noecho ] if curses-error ] + bi ; + SYMBOL: n-registered-colors MEMO: register-color ( fg bg -- n ) @@ -220,7 +223,7 @@ PRIVATE> ] [ window-params ffi:newwin ] if* [ curses-error ] keep >>ptr &dispose - ] [ apply-options ] bi ; + ] [ apply-window-options ] bi ; : with-window ( window quot -- ) [ current-window ] dip with-variable ; inline @@ -230,9 +233,12 @@ PRIVATE> [ '[ ffi:initscr curses-pointer-error - >>ptr dup apply-options + >>ptr + [ apply-global-options ] [ apply-window-options ] [ ] tri + ffi:erase curses-error init-colors + _ with-window ] [ ffi:endwin curses-error ] [ ] cleanup ] with-destructors ; inline @@ -259,7 +265,7 @@ M: curses-terminal dispose init-terminal ffi:initscr curses-pointer-error drop dup ptr>> ffi:set_term curses-pointer-error drop - ] dip apply-options ; + ] dip [ apply-global-options ] [ apply-window-options ] bi ; Date: Thu, 22 Oct 2009 11:05:27 +0200 Subject: [PATCH 08/18] curses: start support for mouse events --- extra/curses/curses.factor | 32 ++++++++++++++++++++++++++++++++ extra/curses/ffi/ffi.factor | 24 +++++++++++++++++++++++- 2 files changed, 55 insertions(+), 1 deletion(-) diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index 895fa52eb7..4d4a714eaa 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -136,6 +136,38 @@ CONSTANT: KEY_EVENT OCT: 633 /* We were interrupted by an event */ CONSTANT: KEY_F0 OCT: 410 /* Function keys. Space for 64 */ : KEY_F ( n -- code ) KEY_F0 + ; inline /* Value of function key n */ +: BUTTON1_RELEASED ( -- mask ) 1 ffi:NCURSES_BUTTON_RELEASED ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON1_PRESSED ( -- mask ) 1 ffi:NCURSES_BUTTON_PRESSED ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON1_CLICKED ( -- mask ) 1 ffi:NCURSES_BUTTON_CLICKED ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON1_DOUBLE_CLICKED ( -- mask ) 1 ffi:NCURSES_DOUBLE_CLICKED ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON1_TRIPLE_CLICKED ( -- mask ) 1 ffi:NCURSES_TRIPLE_CLICKED ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON2_RELEASED ( -- mask ) 2 ffi:NCURSES_BUTTON_RELEASED ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON2_PRESSED ( -- mask ) 2 ffi:NCURSES_BUTTON_PRESSED ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON2_CLICKED ( -- mask ) 2 ffi:NCURSES_BUTTON_CLICKED ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON2_DOUBLE_CLICKED ( -- mask ) 2 ffi:NCURSES_DOUBLE_CLICKED ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON2_TRIPLE_CLICKED ( -- mask ) 2 ffi:NCURSES_TRIPLE_CLICKED ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON3_RELEASED ( -- mask ) 3 ffi:NCURSES_BUTTON_RELEASED ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON3_PRESSED ( -- mask ) 3 ffi:NCURSES_BUTTON_PRESSED ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON3_CLICKED ( -- mask ) 3 ffi:NCURSES_BUTTON_CLICKED ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON3_DOUBLE_CLICKED ( -- mask ) 3 ffi:NCURSES_DOUBLE_CLICKED ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON3_TRIPLE_CLICKED ( -- mask ) 3 ffi:NCURSES_TRIPLE_CLICKED ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON4_RELEASED ( -- mask ) 4 ffi:NCURSES_BUTTON_RELEASED ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON4_PRESSED ( -- mask ) 4 ffi:NCURSES_BUTTON_PRESSED ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON4_CLICKED ( -- mask ) 4 ffi:NCURSES_BUTTON_CLICKED ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON4_DOUBLE_CLICKED ( -- mask ) 4 ffi:NCURSES_DOUBLE_CLICKED ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON4_TRIPLE_CLICKED ( -- mask ) 4 ffi:NCURSES_TRIPLE_CLICKED ffi:NCURSES_MOUSE_MASK ; inline + +: BUTTON1_RESERVED_EVENT ( -- mask ) 1 ffi:NCURSES_RESERVED_EVENT ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON2_RESERVED_EVENT ( -- mask ) 2 ffi:NCURSES_RESERVED_EVENT ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON3_RESERVED_EVENT ( -- mask ) 3 ffi:NCURSES_RESERVED_EVENT ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON4_RESERVED_EVENT ( -- mask ) 4 ffi:NCURSES_RESERVED_EVENT ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON_CTRL ( -- mask ) 5 OCT: 01 ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON_SHIFT ( -- mask ) 5 OCT: 02 ffi:NCURSES_MOUSE_MASK ; inline +: BUTTON_ALT ( -- mask ) 5 OCT: 04 ffi:NCURSES_MOUSE_MASK ; inline +: REPORT_MOUSE_POSITION ( -- mask ) 5 OCT: 10 ffi:NCURSES_MOUSE_MASK ; inline + +: ALL_MOUSE_EVENTS ( -- mask ) REPORT_MOUSE_POSITION 1 - ; inline + ERROR: curses-failed ; ERROR: unsupported-curses-terminal ; diff --git a/extra/curses/ffi/ffi.factor b/extra/curses/ffi/ffi.factor index 591c8c820a..2941f66765 100644 --- a/extra/curses/ffi/ffi.factor +++ b/extra/curses/ffi/ffi.factor @@ -18,6 +18,7 @@ TYPEDEF: uint chtype TYPEDEF: chtype attr_t TYPEDEF: short NCURSES_SIZE_T TYPEDEF: ushort wchar_t +TYPEDEF: ulong mmask_t CONSTANT: CCHARW_MAX 5 @@ -76,6 +77,11 @@ STRUCT: c-window { _bkgrnd cchar_t } ; +STRUCT: MEVENT + { id short } + { x int } { y int } { z int } + { bstate mmask_t } ; + LIBRARY: curses C-GLOBAL: void* stdscr @@ -180,7 +186,6 @@ FUNCTION: int vw_printw ( WINDOW* win, c-string fmt, va_list varglist ) ; FUNCTION: int move ( int y, int x ) ; FUNCTION: int wmove ( WINDOW* win, int y, int x ) ; - FUNCTION: int scroll ( WINDOW* win ) ; FUNCTION: int scrl ( int n ) ; FUNCTION: int wscrl ( WINDOW* win, int n ) ; @@ -252,3 +257,20 @@ C-GLOBAL: int COLOR_PAIRS FUNCTION: int wattron ( WINDOW* win, int attrs ) ; FUNCTION: int wattroff ( WINDOW* win, int attrs ) ; FUNCTION: int wattrset ( WINDOW* win, int attrs ) ; + +: NCURSES_MOUSE_MASK ( b m -- mask ) swap 1 - 5 * shift ; inline + +CONSTANT: NCURSES_BUTTON_RELEASED OCT: 01 +CONSTANT: NCURSES_BUTTON_PRESSED OCT: 02 +CONSTANT: NCURSES_BUTTON_CLICKED OCT: 04 +CONSTANT: NCURSES_DOUBLE_CLICKED OCT: 10 +CONSTANT: NCURSES_TRIPLE_CLICKED OCT: 20 +CONSTANT: NCURSES_RESERVED_EVENT OCT: 40 + +FUNCTION: int getmouse ( MEVENT* event ) ; +FUNCTION: int ungetmouse ( MEVENT* event ) ; +FUNCTION: mmask_t mousemask ( mmask_t newmask, mmask_t* oldmask ) ; +FUNCTION: bool wenclose ( WINDOW* win, int y, int x ) ; +FUNCTION: bool mouse_trafo ( int* pY, int* pX, bool to_screen ) ; +FUNCTION: bool wmouse_trafo ( WINDOW* win, int* pY, int* pX, bool to_screen ) ; +FUNCTION: int mouseinterval ( int erval ) ; From f768bbe59e89fb98faeee8132bf9f15ae1566860 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Br=C3=BCschweiler?= Date: Thu, 22 Oct 2009 13:17:30 +0200 Subject: [PATCH 09/18] curses: change echo to be f as default --- extra/curses/curses.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index 4d4a714eaa..cd55cba1a0 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -193,7 +193,7 @@ TUPLE: curses-window < disposable { x integer initial: 0 } { cbreak initial: t } - { echo initial: t } + { echo initial: f } { raw initial: f } { scrollok initial: t } From 6c31c49cadb0f4a229e728720454ef4f6c8cc4b9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Br=C3=BCschweiler?= Date: Sun, 25 Oct 2009 23:03:03 +0100 Subject: [PATCH 10/18] curses: add box word, rearrange some code --- extra/curses/curses.factor | 18 ++++++++++++++---- extra/curses/ffi/ffi.factor | 5 +++++ 2 files changed, 19 insertions(+), 4 deletions(-) diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index cd55cba1a0..5c4a58e936 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -254,7 +254,7 @@ PRIVATE> ptr>> swap window-params ffi:derwin ] [ window-params ffi:newwin - ] if* [ curses-error ] keep >>ptr &dispose + ] if* curses-pointer-error >>ptr &dispose ] [ apply-window-options ] bi ; : with-window ( window quot -- ) @@ -266,9 +266,13 @@ PRIVATE> '[ ffi:initscr curses-pointer-error >>ptr - [ apply-global-options ] [ apply-window-options ] [ ] tri - - ffi:erase curses-error + { + [ apply-global-options ] + [ apply-window-options ] + [ ptr>> ffi:wclear curses-error ] + [ ptr>> ffi:wrefresh curses-error ] + [ ] + } cleave init-colors _ with-window @@ -402,3 +406,9 @@ PRIVATE> : ccolor ( foreground background -- ) current-window get wccolor ; + +: wccbox ( window -- ) + ptr>> 0 0 ffi:box curses-error ; +: cbox ( -- ) + current-window get wccbox ; + diff --git a/extra/curses/ffi/ffi.factor b/extra/curses/ffi/ffi.factor index 2941f66765..a9ab937814 100644 --- a/extra/curses/ffi/ffi.factor +++ b/extra/curses/ffi/ffi.factor @@ -274,3 +274,8 @@ FUNCTION: bool wenclose ( WINDOW* win, int y, int x ) ; FUNCTION: bool mouse_trafo ( int* pY, int* pX, bool to_screen ) ; FUNCTION: bool wmouse_trafo ( WINDOW* win, int* pY, int* pX, bool to_screen ) ; FUNCTION: int mouseinterval ( int erval ) ; + +FUNCTION: int wborder ( WINDOW* win, chtype ls, chtype rs, chtype ts, chtype bs, chtype tl, chtype tr, chtype bl, chtype br ) ; +FUNCTION: int box ( WINDOW* win, chtype verch, chtype horch ) ; +FUNCTION: int whline ( WINDOW* win, chtype ch, int n ) ; +FUNCTION: int wvline ( WINDOW* win, chtype ch, int n ) ; From 54d846e38a7f2e25a0f9293a0fc5f525db8ab94a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Br=C3=BCschweiler?= Date: Mon, 26 Oct 2009 07:31:43 +0100 Subject: [PATCH 11/18] curses: start mouse input implementation --- extra/curses/curses.factor | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index 5c4a58e936..987cfea2bd 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -412,3 +412,9 @@ PRIVATE> : cbox ( -- ) current-window get wccbox ; +: mousemask ( mask -- newmask oldmask ) + 0 [ ffi:mousemask ] keep *ulong ; + +: getmouse ( -- MEVENT/f ) + ffi:MEVENT dup ffi:getmouse + ffi:ERR = [ drop f ] when ; From b26c88aef33d4024b0f0d2faabb9dce5c6d22b12 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Br=C3=BCschweiler?= Date: Mon, 26 Oct 2009 12:04:49 +0100 Subject: [PATCH 12/18] curses: more mouse event work --- extra/curses/curses.factor | 77 +++++++++++++++++++++++++++++++++++-- extra/curses/ffi/ffi.factor | 2 +- 2 files changed, 74 insertions(+), 5 deletions(-) diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index 987cfea2bd..4d2baa6fb3 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -161,6 +161,7 @@ CONSTANT: KEY_F0 OCT: 410 /* Function keys. Space for 64 */ : BUTTON2_RESERVED_EVENT ( -- mask ) 2 ffi:NCURSES_RESERVED_EVENT ffi:NCURSES_MOUSE_MASK ; inline : BUTTON3_RESERVED_EVENT ( -- mask ) 3 ffi:NCURSES_RESERVED_EVENT ffi:NCURSES_MOUSE_MASK ; inline : BUTTON4_RESERVED_EVENT ( -- mask ) 4 ffi:NCURSES_RESERVED_EVENT ffi:NCURSES_MOUSE_MASK ; inline + : BUTTON_CTRL ( -- mask ) 5 OCT: 01 ffi:NCURSES_MOUSE_MASK ; inline : BUTTON_SHIFT ( -- mask ) 5 OCT: 02 ffi:NCURSES_MOUSE_MASK ; inline : BUTTON_ALT ( -- mask ) 5 OCT: 04 ffi:NCURSES_MOUSE_MASK ; inline @@ -412,9 +413,77 @@ PRIVATE> : cbox ( -- ) current-window get wccbox ; +SYMBOLS: +pressed+ +released+ +clicked+ +double+ +triple+ ; + +TUPLE: mouse-event + { id fixnum } + { y fixnum } + { x fixnum } + { button fixnum } + type + alt + shift + ctrl ; + +>type drop ] } + { BUTTON1_PRESSED [ +pressed+ >>type drop ] } + { BUTTON1_CLICKED [ +clicked+ >>type drop ] } + { BUTTON1_DOUBLE_CLICKED [ +double+ >>type drop ] } + { BUTTON1_TRIPLE_CLICKED [ +triple+ >>type drop ] } + } case ; inline + +: fill-in-bstate ( mouse-event bstate -- ) + 2dup { + { + [ dup 1 button-n? ] + [ [ 1 >>button ] dip 1 substate-n fill-in-type ] + } + { + [ dup 2 button-n? ] + [ [ 2 >>button ] dip 2 substate-n fill-in-type ] + } + { + [ dup 3 button-n? ] + [ [ 3 >>button ] dip 3 substate-n fill-in-type ] + } + { + [ dup 4 button-n? ] + [ [ 4 >>button ] dip 4 substate-n fill-in-type ] + } + } cond + { + [ BUTTON_CTRL bitand 0 = not [ t >>ctrl ] when drop ] + [ BUTTON_SHIFT bitand 0 = not [ t >>shift ] when drop ] + [ BUTTON_ALT bitand 0 = not [ t >>alt ] when drop ] + } 2cleave ; + +: ( MEVENT -- mouse-event ) + [ mouse-event new ] dip { + [ id>> >>id drop ] + [ y>> >>y drop ] + [ x>> >>x drop ] + [ bstate>> fill-in-bstate ] + [ drop ] + } 2cleave ; + +PRIVATE> + +: getmouse ( -- mouse-event/f ) + [ + ffi:MEVENT malloc-struct &free + dup ffi:getmouse + ffi:ERR = [ drop f ] [ ] if + ] with-destructors ; + : mousemask ( mask -- newmask oldmask ) 0 [ ffi:mousemask ] keep *ulong ; - -: getmouse ( -- MEVENT/f ) - ffi:MEVENT dup ffi:getmouse - ffi:ERR = [ drop f ] when ; diff --git a/extra/curses/ffi/ffi.factor b/extra/curses/ffi/ffi.factor index a9ab937814..af231c2f1f 100644 --- a/extra/curses/ffi/ffi.factor +++ b/extra/curses/ffi/ffi.factor @@ -258,7 +258,7 @@ FUNCTION: int wattron ( WINDOW* win, int attrs ) ; FUNCTION: int wattroff ( WINDOW* win, int attrs ) ; FUNCTION: int wattrset ( WINDOW* win, int attrs ) ; -: NCURSES_MOUSE_MASK ( b m -- mask ) swap 1 - 5 * shift ; inline +: NCURSES_MOUSE_MASK ( b m -- mask ) swap 1 - 6 * shift ; inline CONSTANT: NCURSES_BUTTON_RELEASED OCT: 01 CONSTANT: NCURSES_BUTTON_PRESSED OCT: 02 From e674081a06dcfb186160bfe90bea93df63061852 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Br=C3=BCschweiler?= Date: Wed, 23 Dec 2009 20:51:00 +0100 Subject: [PATCH 13/18] curses: cleanup, remove unfinished screen support --- extra/curses/curses.factor | 60 ++++++++++++-------------------------- 1 file changed, 18 insertions(+), 42 deletions(-) diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index 4d2baa6fb3..3f4ad18749 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -177,7 +177,7 @@ ERROR: unsupported-curses-terminal ; : >BOOLEAN ( ? -- TRUE/FALSE ) ffi:TRUE ffi:FALSE ? ; inline : curses-pointer-error ( ptr/f -- ptr ) - dup [ curses-failed ] unless ; inline + [ curses-failed ] unless* ; inline : curses-error ( n -- ) ffi:ERR = [ curses-failed ] when ; PRIVATE> @@ -236,8 +236,8 @@ M: curses-window dispose* ( window -- ) SYMBOL: n-registered-colors MEMO: register-color ( fg bg -- n ) - [ n-registered-colors get ] 2dip ffi:init_pair curses-error - n-registered-colors [ get ] [ inc ] bi ; + [ n-registered-colors get dup ] 2dip ffi:init_pair curses-error + n-registered-colors inc ; : init-colors ( -- ) ffi:has_colors [ @@ -250,12 +250,9 @@ PRIVATE> : setup-window ( window -- window ) [ - dup - dup parent-window>> [ - ptr>> swap window-params ffi:derwin - ] [ - window-params ffi:newwin - ] if* curses-pointer-error >>ptr &dispose + dup [ window-params ] keep + parent-window>> [ ptr>> ffi:derwin ] [ ffi:newwin ] if* + curses-pointer-error >>ptr &dispose ] [ apply-window-options ] bi ; : with-window ( window quot -- ) @@ -280,34 +277,13 @@ PRIVATE> ] [ ffi:endwin curses-error ] [ ] cleanup ] with-destructors ; inline -TUPLE: curses-terminal < disposable - infd outfd ptr ; - -: ( infd outfd ptr -- curses-terminal ) - curses-terminal new-disposable - swap >>ptr - swap >>outfd - swap >>infd ; - -M: curses-terminal dispose - [ outfd>> fclose ] [ infd>> fclose ] - [ ptr>> ffi:delscreen ] tri ; - -: init-terminal ( terminal -- curses-terminal ) - "xterm-color" swap [ "rb" fopen ] [ "wb" fopen ] bi - [ ffi:newterm curses-pointer-error ] 2keep ; - -: start-remote-curses ( terminal window -- curses-terminal ) - [ - init-terminal - ffi:initscr curses-pointer-error drop - dup ptr>> ffi:set_term curses-pointer-error drop - ] dip [ apply-global-options ] [ apply-window-options ] bi ; - : wcread ( n window -- string ) [ encoding>> ] [ ptr>> ] bi (wcread) ; -: curses-read ( n -- string ) current-window get wcread ; +: cread ( n -- string ) current-window get wcread ; : wgetch ( window -- key ) ptr>> (wgetch) ; : getch ( -- key ) current-window get wgetch ; @@ -435,12 +411,12 @@ TUPLE: mouse-event : fill-in-type ( mouse-event substate -- ) { - { BUTTON1_RELEASED [ +released+ >>type drop ] } - { BUTTON1_PRESSED [ +pressed+ >>type drop ] } - { BUTTON1_CLICKED [ +clicked+ >>type drop ] } - { BUTTON1_DOUBLE_CLICKED [ +double+ >>type drop ] } - { BUTTON1_TRIPLE_CLICKED [ +triple+ >>type drop ] } - } case ; inline + { BUTTON1_RELEASED [ +released+ ] } + { BUTTON1_PRESSED [ +pressed+ ] } + { BUTTON1_CLICKED [ +clicked+ ] } + { BUTTON1_DOUBLE_CLICKED [ +double+ ] } + { BUTTON1_TRIPLE_CLICKED [ +triple+ ] } + } case >>type drop ; inline : fill-in-bstate ( mouse-event bstate -- ) 2dup { From c5b46d0be4949553f906a9540f761abe83b9fd33 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Br=C3=BCschweiler?= Date: Thu, 25 Feb 2010 11:48:44 +0100 Subject: [PATCH 14/18] curses: fix colors, add unit test --- extra/curses/curses-tests.factor | 12 +++++++++++- extra/curses/curses.factor | 18 ++++++++---------- extra/curses/ffi/ffi.factor | 2 ++ 3 files changed, 21 insertions(+), 11 deletions(-) diff --git a/extra/curses/curses-tests.factor b/extra/curses/curses-tests.factor index a56f067911..9ffd191681 100644 --- a/extra/curses/curses-tests.factor +++ b/extra/curses/curses-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors calendar curses kernel threads tools.test -strings sequences ; +strings sequences random ; IN: curses.tests : hello-curses ( -- ) @@ -14,6 +14,16 @@ IN: curses.tests 2 seconds sleep ] with-curses ; +: hello-curses-color ( -- ) + [ + "Hello Curses!" [ + 8 random 8 random ccolor addch + ] each crefresh + + 2 seconds sleep + ] with-curses ; + curses-ok? [ [ ] [ hello-curses ] unit-test + [ ] [ hello-curses-color ] unit-test ] when diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index 3f4ad18749..dce102b04e 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -1,14 +1,14 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types alien.strings assocs byte-arrays -classes.struct combinators continuations destructors -fry io io.encodings.8-bit io.encodings.string io.encodings.utf8 -io.streams.c kernel libc locals math memoize multiline -namespaces prettyprint sequences strings threads ; -IN: curses +USING: accessors alien.c-types alien.strings classes.struct +combinators continuations destructors fry io.encodings.utf8 +kernel libc locals math memoize multiline namespaces sequences +unix.ffi ; QUALIFIED-WITH: curses.ffi ffi +IN: curses + SYMBOL: current-window CONSTANT: COLOR_BLACK 0 @@ -244,6 +244,7 @@ MEMO: register-color ( fg bg -- n ) 1 n-registered-colors set \ register-color reset-memoized ffi:start_color curses-error + ffi:stdscr 0 f ffi:wcolor_set curses-error ] when ; PRIVATE> @@ -376,10 +377,7 @@ PRIVATE> : all-attroff ( -- ) current-window get wall-attroff ; : wccolor ( foreground background window -- ) - [ - 2dup [ COLOR_WHITE = ] [ COLOR_BLACK = ] bi* and - [ 2drop 0 ] [ register-color ] if ffi:COLOR_PAIR - ] dip ptr>> (wattron) ; + [ register-color ] dip ptr>> swap f ffi:wcolor_set curses-error ; : ccolor ( foreground background -- ) current-window get wccolor ; diff --git a/extra/curses/ffi/ffi.factor b/extra/curses/ffi/ffi.factor index af231c2f1f..dffdb37e2d 100644 --- a/extra/curses/ffi/ffi.factor +++ b/extra/curses/ffi/ffi.factor @@ -254,6 +254,8 @@ C-GLOBAL: int COLOR_PAIRS : COLOR_PAIR ( n -- n' ) 8 shift ; inline foldable +FUNCTION: int wcolor_set ( WINDOW* win, short color_pair_number, void* opts ) ; + FUNCTION: int wattron ( WINDOW* win, int attrs ) ; FUNCTION: int wattroff ( WINDOW* win, int attrs ) ; FUNCTION: int wattrset ( WINDOW* win, int attrs ) ; From 1819da7f4157afc8b869d534ed99a0c08641de29 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Br=C3=BCschweiler?= Date: Thu, 25 Feb 2010 16:23:37 +0100 Subject: [PATCH 15/18] curses: simplification, use wide character library to print utf8 strings --- extra/curses/curses.factor | 24 ++++++------------------ extra/curses/ffi/ffi.factor | 2 +- 2 files changed, 7 insertions(+), 19 deletions(-) diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index dce102b04e..7d3e4401d5 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -407,8 +407,8 @@ TUPLE: mouse-event : button-n? ( bstate n -- ? ) substate-n 0 = not ; inline -: fill-in-type ( mouse-event substate -- ) - { +: fill-in-type ( mouse-event bstate button -- ) + substate-n { { BUTTON1_RELEASED [ +released+ ] } { BUTTON1_PRESSED [ +pressed+ ] } { BUTTON1_CLICKED [ +clicked+ ] } @@ -418,22 +418,10 @@ TUPLE: mouse-event : fill-in-bstate ( mouse-event bstate -- ) 2dup { - { - [ dup 1 button-n? ] - [ [ 1 >>button ] dip 1 substate-n fill-in-type ] - } - { - [ dup 2 button-n? ] - [ [ 2 >>button ] dip 2 substate-n fill-in-type ] - } - { - [ dup 3 button-n? ] - [ [ 3 >>button ] dip 3 substate-n fill-in-type ] - } - { - [ dup 4 button-n? ] - [ [ 4 >>button ] dip 4 substate-n fill-in-type ] - } + { [ dup 1 button-n? ] [ [ 1 >>button ] dip 1 fill-in-type ] } + { [ dup 2 button-n? ] [ [ 2 >>button ] dip 2 fill-in-type ] } + { [ dup 3 button-n? ] [ [ 3 >>button ] dip 3 fill-in-type ] } + { [ dup 4 button-n? ] [ [ 4 >>button ] dip 4 fill-in-type ] } } cond { [ BUTTON_CTRL bitand 0 = not [ t >>ctrl ] when drop ] diff --git a/extra/curses/ffi/ffi.factor b/extra/curses/ffi/ffi.factor index dffdb37e2d..66fa511619 100644 --- a/extra/curses/ffi/ffi.factor +++ b/extra/curses/ffi/ffi.factor @@ -7,7 +7,7 @@ IN: curses.ffi << "curses" { { [ os winnt? ] [ "libcurses.dll" ] } { [ os macosx? ] [ "libcurses.dylib" ] } - { [ os unix? ] [ "libncurses.so.5.7" ] } + { [ os unix? ] [ "libncursesw.so.5.7" ] } } cond cdecl add-library >> C-TYPE: WINDOW From 15eeb0391e658cda9d9ef1b0b4468b310088fab5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Br=C3=BCschweiler?= Date: Thu, 25 Feb 2010 22:02:47 +0100 Subject: [PATCH 16/18] curses: simplification, implement coordinate queries --- extra/curses/curses.factor | 47 ++++++++++++++++++++++++++++++-------- 1 file changed, 38 insertions(+), 9 deletions(-) diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index 7d3e4401d5..b269d34697 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -317,18 +317,24 @@ PRIVATE> : wcrefresh ( window -- ) ptr>> (wcrefresh) ; : crefresh ( -- ) current-window get wcrefresh ; -: wcnl ( window -- ) [ "\n" ] dip ptr>> (wcwrite) ; +: wgetch ( window -- key ) ptr>> (wgetch) ; +: getch ( -- key ) current-window get wgetch ; + +: waddch ( ch window -- ) ptr>> (waddch) ; +: addch ( ch -- ) current-window get waddch ; + +: wcnl ( window -- ) [ CHAR: \n ] dip waddch ; : cnl ( -- ) current-window get wcnl ; : wcwrite ( string window -- ) ptr>> (wcwrite) ; : cwrite ( string -- ) current-window get wcwrite ; : wcprint ( string window -- ) - ptr>> [ (wcwrite) ] [ "\n" swap (wcwrite) ] bi ; + ptr>> [ (wcwrite) ] [ CHAR: \n swap (waddch) ] bi ; : cprint ( string -- ) current-window get wcprint ; : wcprintf ( string window -- ) - ptr>> [ (wcwrite) ] [ "\n" swap (wcwrite) ] + ptr>> [ (wcwrite) ] [ CHAR: \n swap (waddch) ] [ (wcrefresh) ] tri ; : cprintf ( string -- ) current-window get wcprintf ; @@ -340,12 +346,6 @@ PRIVATE> [ encoding>> ] [ ptr>> ] bi (wcread) ; : cread ( n -- string ) current-window get wcread ; -: wgetch ( window -- key ) ptr>> (wgetch) ; -: getch ( -- key ) current-window get wgetch ; - -: waddch ( ch window -- ) ptr>> (waddch) ; -: addch ( ch -- ) current-window get waddch ; - : werase ( window -- ) ptr>> ffi:werase curses-error ; : erase ( -- ) current-window get werase ; @@ -449,3 +449,32 @@ PRIVATE> : mousemask ( mask -- newmask oldmask ) 0 [ ffi:mousemask ] keep *ulong ; + +: wget-yx ( window -- y x ) + ptr>> ffi:c-window memory>struct [ _cury>> ] [ _curx>> ] bi ; +: get-yx ( -- y x ) + current-window get wget-yx ; + +: wget-y ( window -- y ) + ptr>> ffi:c-window memory>struct _cury>> ; +: get-y ( -- y ) + current-window get wget-y ; +: wget-x ( window -- x ) + ptr>> ffi:c-window memory>struct _curx>> ; +: get-x ( -- x ) + current-window get wget-x ; + +: wget-max-yx ( window -- y x ) + ptr>> ffi:c-window memory>struct + [ _maxy>> 1 + ] [ _maxx>> 1 + ] bi ; +: get-max-yx ( -- y x ) + current-window get wget-max-yx ; + +: wget-max-y ( window -- y ) + ptr>> ffi:c-window memory>struct _maxy>> 1 + ; +: get-max-y ( -- y ) + current-window get wget-max-y ; +: wget-max-x ( window -- x ) + ptr>> ffi:c-window memory>struct _maxx>> 1 + ; +: get-max-x ( -- x ) + current-window get wget-max-x ; 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 17/18] 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. From f52246b3ffd932cee6050af0e1344f5127087e14 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Br=C3=BCschweiler?= Date: Fri, 26 Feb 2010 00:38:17 +0100 Subject: [PATCH 18/18] curses: simplifications, prepare for menu support --- extra/curses/curses.factor | 14 +++++++------- extra/curses/ffi/ffi.factor | 5 ++--- 2 files changed, 9 insertions(+), 10 deletions(-) diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index b269d34697..0db3e8f649 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -133,6 +133,7 @@ CONSTANT: KEY_UNDO OCT: 630 /* undo key */ CONSTANT: KEY_MOUSE OCT: 631 /* Mouse event has occurred */ CONSTANT: KEY_RESIZE OCT: 632 /* Terminal resize event */ CONSTANT: KEY_EVENT OCT: 633 /* We were interrupted by an event */ +CONSTANT: KEY_MAX OCT: 777 /* Maximum key value is 0633 */ CONSTANT: KEY_F0 OCT: 410 /* Function keys. Space for 64 */ : KEY_F ( n -- code ) KEY_F0 + ; inline /* Value of function key n */ @@ -451,30 +452,29 @@ PRIVATE> 0 [ ffi:mousemask ] keep *ulong ; : wget-yx ( window -- y x ) - ptr>> ffi:c-window memory>struct [ _cury>> ] [ _curx>> ] bi ; + ptr>> [ _cury>> ] [ _curx>> ] bi ; : get-yx ( -- y x ) current-window get wget-yx ; : wget-y ( window -- y ) - ptr>> ffi:c-window memory>struct _cury>> ; + ptr>> _cury>> ; : get-y ( -- y ) current-window get wget-y ; : wget-x ( window -- x ) - ptr>> ffi:c-window memory>struct _curx>> ; + ptr>> _curx>> ; : get-x ( -- x ) current-window get wget-x ; : wget-max-yx ( window -- y x ) - ptr>> ffi:c-window memory>struct - [ _maxy>> 1 + ] [ _maxx>> 1 + ] bi ; + ptr>> [ _maxy>> 1 + ] [ _maxx>> 1 + ] bi ; : get-max-yx ( -- y x ) current-window get wget-max-yx ; : wget-max-y ( window -- y ) - ptr>> ffi:c-window memory>struct _maxy>> 1 + ; + ptr>> _maxy>> 1 + ; : get-max-y ( -- y ) current-window get wget-max-y ; : wget-max-x ( window -- x ) - ptr>> ffi:c-window memory>struct _maxx>> 1 + ; + ptr>> _maxx>> 1 + ; : get-max-x ( -- x ) current-window get wget-max-x ; diff --git a/extra/curses/ffi/ffi.factor b/extra/curses/ffi/ffi.factor index 66fa511619..85bc15d34b 100644 --- a/extra/curses/ffi/ffi.factor +++ b/extra/curses/ffi/ffi.factor @@ -7,10 +7,9 @@ IN: curses.ffi << "curses" { { [ os winnt? ] [ "libcurses.dll" ] } { [ os macosx? ] [ "libcurses.dylib" ] } - { [ os unix? ] [ "libncursesw.so.5.7" ] } + { [ os unix? ] [ "libncursesw.so" ] } } cond cdecl add-library >> -C-TYPE: WINDOW C-TYPE: SCREEN TYPEDEF: void* va_list @@ -38,7 +37,7 @@ STRUCT: pdat { _pad_bottom NCURSES_SIZE_T } { _pad_right NCURSES_SIZE_T } ; -STRUCT: c-window +STRUCT: WINDOW { _cury NCURSES_SIZE_T } { _curx NCURSES_SIZE_T }