alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Hide more of ansi

Browse Source
This commit is contained in:
Brad Nelson
2021-02-06 16:47:34 -08:00
parent cf056a58b6
commit 72ac2a39d3
3 changed files with 12 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
ueforth/common/ansi.fs
View File

@ -1,11 +1,7 @@
( ANSI Codes ) ( ANSI Codes )
vocabulary ansi ansi definitions
: n. ( n -- ) base @ swap decimal <# #s #> type base ! ; : n. ( n -- ) base @ swap decimal <# #s #> type base ! ;
: esc 27 emit ; : bel 7 emit ; : esc 27 emit ; : bel 7 emit ;
: at-xy ( x y -- ) esc ." [" 1+ n. ." ;" 1+ n. ." H" ;
: page esc ." [2J" esc ." [H" ;
: normal esc ." [0m" ;
: fg ( n -- ) esc ." [38;5;" n. ." m" ;
: bg ( n -- ) esc ." [48;5;" n. ." m" ;
: clear-to-eol esc ." [0K" ; : clear-to-eol esc ." [0K" ;
: scroll-down esc ." D" ; : scroll-down esc ." D" ;
: scroll-up esc ." M" ; : scroll-up esc ." M" ;
@ -14,3 +10,10 @@
: terminal-save esc ." [?1049h" ; : terminal-save esc ." [?1049h" ;
: terminal-restore esc ." [?1049l" ; : terminal-restore esc ." [?1049l" ;
forth definitions ansi
: fg ( n -- ) esc ." [38;5;" n. ." m" ;
: bg ( n -- ) esc ." [48;5;" n. ." m" ;
: normal esc ." [0m" ;
: at-xy ( x y -- ) esc ." [" 1+ n. ." ;" 1+ n. ." H" ;
: page esc ." [2J" esc ." [H" ;
forth

2
ueforth/common/testing.fs
View File

@ -45,7 +45,9 @@ variable tests-found variable tests-run variable tests-passed
: check-fresh depth if }confirm ." DEPTH LEAK! " depth . 1 throw then ; : check-fresh depth if }confirm ." DEPTH LEAK! " depth . 1 throw then ;
: wrap-test ( xt -- ) expect-reset >r check-fresh r> execute check-fresh expect-finish ; : wrap-test ( xt -- ) expect-reset >r check-fresh r> execute check-fresh expect-finish ;
: red 1 fg ; : green 2 fg ; : hr 40 for [char] - emit next cr ; : red 1 fg ; : green 2 fg ; : hr 40 for [char] - emit next cr ;
ansi
: replace-line 13 emit clear-to-eol ; : replace-line 13 emit clear-to-eol ;
forth
: label-test ( xt -- ) replace-line >name type ; : label-test ( xt -- ) replace-line >name type ;
: run-test ( xt -- ) dup label-test confirm{ ['] wrap-test catch }confirm : run-test ( xt -- ) dup label-test confirm{ ['] wrap-test catch }confirm
if drop ( cause xt restored on throw ) red ." FAILED" normal cr if drop ( cause xt restored on throw ) red ." FAILED" normal cr

2
ueforth/windows/windows.fs
View File

@ -87,7 +87,9 @@ stdout console-mode @ ENABLE_VIRTUAL_TERMINAL_PROCESSING or SetConsoleMode drop
' win-bye is bye ' win-bye is bye
-1 echo ! -1 echo !
ansi
: set-title ( a n -- ) esc ." ]0;" type bel ; : set-title ( a n -- ) esc ." ]0;" type bel ;
windows
s" uEforth" set-title s" uEforth" set-title
( Window File Specific ) ( Window File Specific )