curses: fix colors, add unit test

db4
Philipp Brüschweiler 2010-02-25 11:48:44 +01:00
parent e674081a06
commit c5b46d0be4
3 changed files with 21 additions and 11 deletions

View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Doug Coleman. ! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors calendar curses kernel threads tools.test USING: accessors calendar curses kernel threads tools.test
strings sequences ; strings sequences random ;
IN: curses.tests IN: curses.tests
: hello-curses ( -- ) : hello-curses ( -- )
@ -14,6 +14,16 @@ IN: curses.tests
2 seconds sleep 2 seconds sleep
] with-curses ; ] with-curses ;
: hello-curses-color ( -- )
<curses-window> [
"Hello Curses!" [
8 random 8 random ccolor addch
] each crefresh
2 seconds sleep
] with-curses ;
curses-ok? [ curses-ok? [
[ ] [ hello-curses ] unit-test [ ] [ hello-curses ] unit-test
[ ] [ hello-curses-color ] unit-test
] when ] when

View File

@ -1,14 +1,14 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.strings assocs byte-arrays USING: accessors alien.c-types alien.strings classes.struct
classes.struct combinators continuations destructors combinators continuations destructors fry io.encodings.utf8
fry io io.encodings.8-bit io.encodings.string io.encodings.utf8 kernel libc locals math memoize multiline namespaces sequences
io.streams.c kernel libc locals math memoize multiline unix.ffi ;
namespaces prettyprint sequences strings threads ;
IN: curses
QUALIFIED-WITH: curses.ffi ffi QUALIFIED-WITH: curses.ffi ffi
IN: curses
SYMBOL: current-window SYMBOL: current-window
CONSTANT: COLOR_BLACK 0 CONSTANT: COLOR_BLACK 0
@ -244,6 +244,7 @@ MEMO: register-color ( fg bg -- n )
1 n-registered-colors set 1 n-registered-colors set
\ register-color reset-memoized \ register-color reset-memoized
ffi:start_color curses-error ffi:start_color curses-error
ffi:stdscr 0 f ffi:wcolor_set curses-error
] when ; ] when ;
PRIVATE> PRIVATE>
@ -376,10 +377,7 @@ PRIVATE>
: all-attroff ( -- ) current-window get wall-attroff ; : all-attroff ( -- ) current-window get wall-attroff ;
: wccolor ( foreground background window -- ) : wccolor ( foreground background window -- )
[ [ register-color ] dip ptr>> swap f ffi:wcolor_set curses-error ;
2dup [ COLOR_WHITE = ] [ COLOR_BLACK = ] bi* and
[ 2drop 0 ] [ register-color ] if ffi:COLOR_PAIR
] dip ptr>> (wattron) ;
: ccolor ( foreground background -- ) : ccolor ( foreground background -- )
current-window get wccolor ; current-window get wccolor ;

View File

@ -254,6 +254,8 @@ C-GLOBAL: int COLOR_PAIRS
: COLOR_PAIR ( n -- n' ) 8 shift ; inline foldable : 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 wattron ( WINDOW* win, int attrs ) ;
FUNCTION: int wattroff ( WINDOW* win, int attrs ) ; FUNCTION: int wattroff ( WINDOW* win, int attrs ) ;
FUNCTION: int wattrset ( WINDOW* win, int attrs ) ; FUNCTION: int wattrset ( WINDOW* win, int attrs ) ;