diff options
| -rw-r--r-- | sanctuary.fs | 16 | ||||
| -rw-r--r-- | test.fs | 61 |
2 files changed, 63 insertions, 14 deletions
diff --git a/sanctuary.fs b/sanctuary.fs index 7d2c88d..ac71042 100644 --- a/sanctuary.fs +++ b/sanctuary.fs @@ -51,6 +51,12 @@ else >body [compile] literal ['] compile, compile, then ; immediate compile-only \ todo doc +: case 0 ; immediate +: of postpone over postpone = postpone if postpone drop ; immediate +: endof postpone else ; immediate +: endcase postpone drop begin ?dup while postpone then repeat ; immediate + +\ todo doc : recurse latest @ >body compile, ; immediate : cells 8 * ; @@ -594,6 +600,16 @@ decimal : words get-order 0 ?do vlist loop ; \ }}} +\ TERMINAL CONTROL {{{ +vocabulary terminal +also terminal definitions + +60 constant termios# +create termios termios# allot + +previous definitions +\ }}} + \ todo doc 0 constant version : welcome ." sanctuary: a 64 bit forth for linux, version " version u. cr ; @@ -374,6 +374,36 @@ t{ -1 gi1 -> 123 }t t{ <false> melse -> 2 4 }t t{ <true> melse -> 1 3 5 }t +: CS1 case 1 of 111 endof + 2 of 222 endof + 3 of 333 endof + >r 999 r> + endcase +; +t{ 1 CS1 -> 111 }t +t{ 2 CS1 -> 222 }t +t{ 3 CS1 -> 333 }t +t{ 4 CS1 -> 999 }t +: CS2 >r case + -1 of case r@ 1 of 100 endof + 2 of 200 endof + >r -300 r> + endcase + endof + -2 of case r@ 1 of -99 endof + >r -199 r> + endcase + endof + >r 299 r> + endcase r> drop ; + +t{ -1 1 CS2 -> 100 }t +t{ -1 2 CS2 -> 200 }t +t{ -1 3 CS2 -> -300 }t +t{ -2 1 CS2 -> -99 }t +t{ -2 2 CS2 -> -199 }t +t{ 0 2 CS2 -> 299 }t + t{ : gi3 begin dup 5 < while dup 1+ repeat ; -> }t t{ 0 gi3 -> 0 1 2 3 4 5 }t t{ 4 gi3 -> 4 5 }t @@ -400,20 +430,23 @@ t{ :noname ( N -- 0, 1, .., N ) t{ 0 RN1 execute -> 0 }t t{ 4 RN1 execute -> 0 1 2 3 4 }t -\ :noname ( N -- N1 ) -\ 1- dup -\ case 0 of exit endof -\ 1 of 11 swap recurse endof -\ 2 of 22 swap recurse endof -\ 3 of 33 swap recurse endof -\ drop abs recurse exit -\ endcase -\ ; constant RN2 -\ -\ t{ 1 RN2 execute -> 0 }t -\ t{ 2 RN2 execute -> 11 0 }t -\ t{ 4 RN2 execute -> 33 22 11 0 }t -\ t{ 25 RN2 execute -> 33 22 11 0 }t +\ todo broken +\ i think the case is splunging up the recurse +\ i dont know why, because recurse takes no arguments +:noname ( N -- N1 ) + 1- dup + case 0 of exit endof + 1 of 11 swap recurse endof + 2 of 22 swap recurse endof + 3 of 33 swap recurse endof + drop abs recurse exit + endcase +; constant RN2 + +t{ 1 RN2 execute -> 0 }t +t{ 2 RN2 execute -> 11 0 }t +t{ 4 RN2 execute -> 33 22 11 0 }t +t{ 25 RN2 execute -> 33 22 11 0 }t hex t{ : gd1 do i loop ; -> }t |