diff options
Diffstat (limited to 'sanctuary.fs')
| -rw-r--r-- | sanctuary.fs | 92 |
1 files changed, 88 insertions, 4 deletions
diff --git a/sanctuary.fs b/sanctuary.fs index ac71042..dc2fc8c 100644 --- a/sanctuary.fs +++ b/sanctuary.fs @@ -424,10 +424,8 @@ hex b16b0065cafebabe constant empty-voc-magic decimal : empty-wordlist? ( wid -- ? ) @ cell- @ empty-voc-magic = ; : wordlist empty-voc-magic , here 0 , ; -wordlist constant forth-wordlist defer default-wordlist -:noname forth-wordlist 1 ; is default-wordlist \ the most recent is stored toward high memory : get-order ( -- widn ... wid1 n ) @@ -446,10 +444,17 @@ defer default-wordlist i cells context + ! loop ; +\ Bad Thing: using one of these words on their own +\ will make it the only vocabulary which breaks things +\ maybe vocabulary should perform `also`? : (vocabulary) create , does> >r get-order swap drop r> swap set-order ; : vocabulary wordlist (vocabulary) ; +vocabulary forth +' forth 21 + constant forth-wordlist \ hack; depends on create +:noname forth-wordlist 1 ; is default-wordlist + : get-current ( -- wid ) current @ ; : set-current ( wid -- ) current ! ; @@ -459,7 +464,6 @@ defer default-wordlist : only -1 set-order ; : also get-order over swap 1+ set-order ; -forth-wordlist (vocabulary) forth -1 set-order : visible? ( ht -- ? ) >ffa c@ 1 and 0= ; @@ -488,7 +492,12 @@ private{ >r >r 2drop r> r> ( ht -1 ) unloop exit then - loop 0 ; + loop ( 0 ; ) + \ prevent having Nothing in the dictionary + \ should do something in `vocabulary` to fix this really + 2dup forth-wordlist search-wordlist dup 0<> if + >r >r 2drop r> r> exit + then ; : (smudge) latest @ >ffa dup c@ [ hex ] 01 [ decimal ] xor swap c! ; : (immediate) latest @ >ffa dup c@ [ hex ] 02 [ decimal ] or swap c! ; @@ -598,14 +607,89 @@ decimal \ doesn't work when there are multiple vocabularies, \ for some reason the header of the last word is printed : words get-order 0 ?do vlist loop ; + +: bytes-allocated dp$ @ dp0 @ - ; +: bytes-used here dp0 @ - ; +: bytes-free bytes-allocated bytes-used - ; + \ }}} \ TERMINAL CONTROL {{{ +\ todo doc vocabulary terminal also terminal definitions 60 constant termios# create termios termios# allot +create old-termios termios# allot + +: termios.c_iflag ; +: termios.c_oflag 4 + ; +: termios.c_cflag 8 + ; +: termios.c_lflag 12 + ; +: termios.c_line 16 + ; +: termios.c_cc 17 + ; + +\ consts {{{ +hex +5401 constant TCGETS +5402 constant TCSETS +5403 constant TCSETSW +5404 constant TCSETSF + +1 constant IGNBRK 2 constant BRKINT 4 constant IGNPAR +8 constant PARMRK 10 constant INPCK 20 constant ISTRIP +40 constant INLCR 80 constant IGNCR 100 constant ICRNL +200 constant IUCLC 400 constant IXON 800 constant IXANY +1000 constant IXOFF 2000 constant IMAXBEL 4000 constant IUTF8 + +1 constant OPOST + +1 constant ISIG 2 constant ICANON 8 constant ECHO +40 constant ECHONL 8000 constant IEXTEN + +30 constant CSIZE 30 constant CS8 100 constant PARENB +decimal +\ }}} + +: ioctl 16 syscall3 ; + +: ESC 27 emit ; +: CSI ESC ." [" ; + +: CSIm ( n -- ) CSI (.) type ." m" ; + +: foreground 30 + CSIm ; +: background 40 + CSIm ; + +0 constant black 1 constant red 2 constant green +3 constant yellow 4 constant blue 5 constant magenta +6 constant cyan 7 constant white 9 constant default + +: bold 1 CSIm ; : normal 0 CSIm ; + +: at-xy ( x y -- ) CSI 1+ (.) type ." ;" 1+ (.) type ." H" ; +: page CSI ." 2J" 0 0 at-xy ; + +: restore-termios old-termios TCSETSF stdin ioctl ; +: backup-termios old-termios TCGETS stdin ioctl ; +: cooked restore-termios ; +\ SETTING RAW MODE FLAGS {{{ +\ see termios(3) +: raw-iflag ( tios -- ) termios.c_iflag dup @ + IGNBRK BRKINT or PARMRK or ISTRIP or INLCR or IGNCR or ICRNL or IXON or + negate and swap ! ; +: raw-oflag ( tios -- ) termios.c_oflag dup @ OPOST negate and swap ! ; +: raw-lflag ( tios -- ) termios.c_lflag dup @ + ECHO ECHONL or ICANON or ISIG or IEXTEN or negate and swap ! ; +: raw-cflag ( tios -- ) termios.c_cflag dup @ + CSIZE PARENB or negate and CS8 or swap ! ; +\ }}} +: raw backup-termios termios dup raw-iflag dup raw-oflag dup raw-lflag + dup raw-cflag TCSETSF stdin ioctl ; + +: altscr CSI ." ?1049h" ; +: normscr CSI ." ?1049l" ; previous definitions \ }}} |