curses: renamed to shorter words

diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor
index 78ff542ff9ffe773131b7257a8495c88fc024573..5a361f891f9e51ff821e7145b9734963adb03785 100644 (file)
--- 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 ;
+<PRIVATE
+
+: >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 ;
 
 <PRIVATE
 
@@ -60,65 +68,58 @@ M: curses-window dispose* ( window -- )
     { [ lines>> ] [ 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
 
-<PRIVATE
-
-: init-colors ( -- )
-    has_colors [
-        1 n-registered-colors set
-        \ register-color reset-memoized
-        start_color curses-error
-    ] when ;
-
-: curses-pointer-error ( ptr/f -- ptr )
-    dup [ curses-failed ] unless ; inline
-
-PRIVATE>
-
 : 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 <curses-terminal> ;
+    [ ffi:newterm curses-pointer-error ] 2keep <curses-terminal> ;
 
 : 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 ;
     
-
 <PRIVATE
 
-: (window-curses-refresh) ( window-ptr -- ) wrefresh curses-error ; inline
-: (window-curses-write) ( string window-ptr -- ) swap waddstr curses-error ; inline
+: (wcrefresh) ( window-ptr -- ) ffi:wrefresh curses-error ; inline
+: (wcwrite) ( string window-ptr -- ) swap ffi:waddstr curses-error ; inline
 
-:: (window-curses-read) ( n encoding window-ptr -- string )
+:: (wcread) ( n encoding window-ptr -- string )
     [
         n 1 + malloc &free :> 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 ;
-
-: 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) ;
+: 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 ;
+
+: wcprint ( string window -- )
+    ptr>> [ (wcwrite) ] [ "\n" swap (wcwrite) ] bi ;
+: cprint ( string -- ) current-window get wcprint ;
+
+: wcprintf ( string window -- )
+    ptr>> [ (wcwrite) ] [ "\n" swap (wcwrite) ]
+    [ (wcrefresh) ] tri ;
+: curses-print-refresh ( string -- ) current-window get wcprintf ;
+
+: wcwritef ( string window -- )
+    ptr>> [ (wcwrite) ] [ (wcrefresh) ] bi ;
+: cwritef ( string -- ) current-window get wcwritef ;
+
+: wcread ( n window -- string )
+    [ encoding>> ] [ ptr>> ] bi (wcread) ;
+: curses-read ( 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 ;
+
+: wcmove ( y x window -- )
+    ptr>> [ (wcmove) ] [ (wcrefresh) ] bi ;
+: cmove ( y x -- ) current-window get wcmove ;
+
+: 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 ;