curses: fix colors, add unit test

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 ( -- )
+    <curses-window> [
+        "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

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 ;

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 ) ;