 ! 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
 

    [
        dup
        dup parent-window>> [
            ptr>> swap window-params derwin
        ] [
            window-params 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
            >>ptr dup apply-options
        ] dip
        erase curses-error
        init-colors
        [
            [ endwin curses-error ] [ ] cleanup
        ] curry with-window
    ] with-destructors ; inline


    { [ lines>> ] [ columns>> ] [ y>> ] [ x>> ] } cleave ;

: set-cbreak/raw ( cbreak raw -- )
    [ drop ffi:raw ] [
        [ ffi:cbreak ] [ ffi:nocbreak ] if
    ] if curses-error ;

: apply-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 ;

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 ;

: init-colors ( -- )
    ffi:has_colors [
        1 n-registered-colors set
        \ register-color reset-memoized
        ffi:start_color curses-error
    ] when ;

PRIVATE>

