Merge remote-tracking branch 'blei/curses' into curses
John Benediktsson
commit
b40e787556
|
|
@ -1,19 +1,29 @@
|
|||
! 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 random ;
|
||||
IN: curses.tests
|
||||
|
||||
: hello-curses ( -- )
|
||||
[
|
||||
curses-window new
|
||||
"mainwin" >>name
|
||||
add-curses-window
|
||||
<curses-window> [
|
||||
"Hello Curses!" [
|
||||
dup cmove addch
|
||||
] each-index
|
||||
crefresh
|
||||
|
||||
"mainwin" "hi" curses-printf
|
||||
2 seconds sleep
|
||||
] with-curses ;
|
||||
|
||||
2000000 sleep
|
||||
: 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
|
||||
|
|
|
|||
|
|
@ -1,162 +1,480 @@
|
|||
! 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 ;
|
||||
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: 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
|
||||
|
||||
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
|
||||
|
||||
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_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 */
|
||||
|
||||
: 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: 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 ;
|
||||
<PRIVATE
|
||||
|
||||
: window-ptr ( string -- window ) get-window ptr>> ;
|
||||
: >BOOLEAN ( ? -- TRUE/FALSE ) ffi:TRUE ffi:FALSE ? ; inline
|
||||
|
||||
: curses-error ( n -- ) ERR = [ curses-failed ] when ;
|
||||
: curses-pointer-error ( ptr/f -- ptr )
|
||||
[ curses-failed ] unless* ; inline
|
||||
: curses-error ( n -- ) ffi:ERR = [ curses-failed ] when ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: 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 }
|
||||
{ x integer initial: 0 }
|
||||
|
||||
{ cbreak initial: t }
|
||||
{ echo initial: t }
|
||||
{ echo initial: f }
|
||||
{ raw initial: f }
|
||||
|
||||
{ scrollok initial: t }
|
||||
{ leaveok initial: f }
|
||||
|
||||
idcok idlok immedok
|
||||
{ keypad initial: f } ;
|
||||
{ keypad initial: t }
|
||||
|
||||
M: curses-window dispose ( window -- )
|
||||
ptr>> delwin curses-error ;
|
||||
{ encoding initial: utf8 } ;
|
||||
|
||||
: <curses-window> ( -- window )
|
||||
curses-window new-disposable ;
|
||||
|
||||
M: curses-window dispose* ( window -- )
|
||||
ptr>> ffi:delwin curses-error ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: add-window ( window -- )
|
||||
dup name>> [ 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 ffi:raw ] [
|
||||
[ ffi:cbreak ] [ ffi:nocbreak ] if
|
||||
] if curses-error ;
|
||||
|
||||
: apply-window-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 ]
|
||||
[ 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 ]
|
||||
[ [ 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 )
|
||||
[ n-registered-colors get dup ] 2dip ffi:init_pair curses-error
|
||||
n-registered-colors inc ;
|
||||
|
||||
: init-colors ( -- )
|
||||
ffi:has_colors [
|
||||
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>
|
||||
|
||||
: 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 <byte-array> :> 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 [ window-params ] keep
|
||||
parent-window>> [ ptr>> ffi:derwin ] [ ffi:newwin ] if*
|
||||
curses-pointer-error >>ptr &dispose
|
||||
] [ apply-window-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
|
||||
[
|
||||
'[
|
||||
ffi:initscr curses-pointer-error
|
||||
>>ptr
|
||||
{
|
||||
[ apply-global-options ]
|
||||
[ apply-window-options ]
|
||||
[ ptr>> ffi:wclear curses-error ]
|
||||
[ ptr>> ffi:wrefresh curses-error ]
|
||||
[ ]
|
||||
} cleave
|
||||
init-colors
|
||||
|
||||
: insert-line ( window-name y string -- )
|
||||
[ dupd insert-blank-line ] dip
|
||||
curses-writef ;
|
||||
_ with-window
|
||||
] [ ffi:endwin curses-error ] [ ] cleanup
|
||||
] with-destructors ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: (wcrefresh) ( window-ptr -- )
|
||||
ffi:wrefresh curses-error ; inline
|
||||
|
||||
: (wcwrite) ( string window-ptr -- )
|
||||
swap ffi:waddstr curses-error ; inline
|
||||
|
||||
:: (wcread) ( n encoding window-ptr -- string )
|
||||
[
|
||||
n 1 + malloc &free :> str
|
||||
window-ptr str n ffi:wgetnstr curses-error
|
||||
str encoding alien>string
|
||||
] with-destructors ; inline
|
||||
|
||||
: (wcmove) ( y x window-ptr -- )
|
||||
-rot ffi:wmove curses-error ; inline
|
||||
|
||||
: (winsert-blank-line) ( y window-ptr -- )
|
||||
[ 0 swap (wcmove) ]
|
||||
[ ffi:winsertln curses-error ] bi ; inline
|
||||
|
||||
: (waddch) ( ch window-ptr -- )
|
||||
swap ffi:waddch curses-error ; inline
|
||||
|
||||
: (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 ;
|
||||
|
||||
: 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) ] [ CHAR: \n swap (waddch) ] bi ;
|
||||
: cprint ( string -- ) current-window get wcprint ;
|
||||
|
||||
: wcprintf ( string window -- )
|
||||
ptr>> [ (wcwrite) ] [ CHAR: \n swap (waddch) ]
|
||||
[ (wcrefresh) ] tri ;
|
||||
: cprintf ( 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) ;
|
||||
: cread ( n -- string ) current-window get wcread ;
|
||||
|
||||
: 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 winsert-blank-line ;
|
||||
|
||||
: winsert-line ( string y window -- )
|
||||
ptr>> [ (winsert-blank-line) ] [ (wcwrite) ] bi ;
|
||||
: 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 -- )
|
||||
[ register-color ] dip ptr>> swap f ffi:wcolor_set curses-error ;
|
||||
|
||||
: ccolor ( foreground background -- )
|
||||
current-window get wccolor ;
|
||||
|
||||
: wccbox ( window -- )
|
||||
ptr>> 0 0 ffi:box curses-error ;
|
||||
: 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 ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: substate-n ( bstate n -- substate )
|
||||
[ 1 + ffi:NCURSES_BUTTON_RELEASED ffi:NCURSES_MOUSE_MASK 1 - bitand ] keep
|
||||
1 - -6 * shift ; inline
|
||||
|
||||
: button-n? ( bstate n -- ? ) substate-n 0 = not ; inline
|
||||
|
||||
: fill-in-type ( mouse-event bstate button -- )
|
||||
substate-n {
|
||||
{ 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 {
|
||||
{ [ 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 ]
|
||||
[ BUTTON_SHIFT bitand 0 = not [ t >>shift ] when drop ]
|
||||
[ BUTTON_ALT bitand 0 = not [ t >>alt ] when drop ]
|
||||
} 2cleave ;
|
||||
|
||||
: <mouse-event> ( 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 ] [ <mouse-event> ] if
|
||||
] with-destructors ;
|
||||
|
||||
: mousemask ( mask -- newmask oldmask )
|
||||
0 <ulong> [ ffi:mousemask ] keep *ulong ;
|
||||
|
||||
: wget-yx ( window -- y x )
|
||||
ptr>> [ _cury>> ] [ _curx>> ] bi ;
|
||||
: get-yx ( -- y x )
|
||||
current-window get wget-yx ;
|
||||
|
||||
: wget-y ( window -- y )
|
||||
ptr>> _cury>> ;
|
||||
: get-y ( -- y )
|
||||
current-window get wget-y ;
|
||||
: wget-x ( window -- x )
|
||||
ptr>> _curx>> ;
|
||||
: get-x ( -- x )
|
||||
current-window get wget-x ;
|
||||
|
||||
: wget-max-yx ( window -- y x )
|
||||
ptr>> [ _maxy>> 1 + ] [ _maxx>> 1 + ] bi ;
|
||||
: get-max-yx ( -- y x )
|
||||
current-window get wget-max-yx ;
|
||||
|
||||
: wget-max-y ( window -- y )
|
||||
ptr>> _maxy>> 1 + ;
|
||||
: get-max-y ( -- y )
|
||||
current-window get wget-max-y ;
|
||||
: wget-max-x ( window -- x )
|
||||
ptr>> _maxx>> 1 + ;
|
||||
: get-max-x ( -- x )
|
||||
current-window get wget-max-x ;
|
||||
|
|
|
|||
|
|
@ -1,16 +1,15 @@
|
|||
! 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? ] [ "libncursesw.so" ] }
|
||||
} cond cdecl add-library >>
|
||||
|
||||
C-TYPE: WINDOW
|
||||
C-TYPE: SCREEN
|
||||
TYPEDEF: void* va_list
|
||||
|
||||
|
|
@ -18,59 +17,69 @@ TYPEDEF: uint chtype
|
|||
TYPEDEF: chtype attr_t
|
||||
TYPEDEF: short NCURSES_SIZE_T
|
||||
TYPEDEF: ushort wchar_t
|
||||
TYPEDEF: ulong mmask_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 }
|
||||
STRUCT: WINDOW
|
||||
{ _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 } ;
|
||||
|
||||
STRUCT: MEVENT
|
||||
{ id short }
|
||||
{ x int } { y int } { z int }
|
||||
{ bstate mmask_t } ;
|
||||
|
||||
LIBRARY: curses
|
||||
|
||||
|
|
@ -134,13 +143,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 ( ) ;
|
||||
|
|
@ -176,27 +185,26 @@ 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 ) ;
|
||||
|
||||
! 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 +237,46 @@ 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 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 ) ;
|
||||
|
||||
: NCURSES_MOUSE_MASK ( b m -- mask ) swap 1 - 6 * 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 ) ;
|
||||
|
||||
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 ) ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Philipp Brüschweiler
|
||||
|
|
@ -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-window> [
|
||||
curses-listener-stream dup [ listener ] with-streams*
|
||||
] with-curses ;
|
||||
|
||||
: test-listener ( -- )
|
||||
global [ run-listener ] bind ;
|
||||
|
||||
MAIN: run-listener
|
||||
|
|
@ -0,0 +1 @@
|
|||
unix
|
||||
|
|
@ -0,0 +1 @@
|
|||
A curses-based Factor listener.
|
||||
Loading…
Reference in New Issue