retroforth/takawiri.retro
crc ba12145728 takawiri: use ioctl: to get terminal size; report errors on start if too small
FossilOrigin-Name: e6b1567ab2db12c536a596913be21f5fb774209c7e67a395cd54e936dfdc47b4
2024-01-22 16:49:17 +00:00

217 lines
4.9 KiB
Forth
Executable file

#!/usr/bin/env retro
================================================================
_ _ _ _
| |_ __ _| | ____ ___ _(_)_ __(_) crc's new listener for
| __/ _` | |/ / _` \ \ /\ / / | '__| | RetroForth
| || (_| | < (_| |\ V V /| | | | |
\__\__,_|_|\_\__,_| \_/\_/ |_|_| |_| ** UNDER DEVELOPMENT **
================================================================
# Terminal Configuration
Setup the text output buffer dimensions.
~~~
#80 'TOB:W const
#25 'TOB:H const
~~~
Setup the local terminal dimensions. This requires the current
development build of Retro to gain access to the `ioctl:` words.
(If not using this, hard code the terminal constraints for your
system).
~~~
ioctl:term-size (rows,cols) 'LT:W const 'LT:H const
~~~
~~~
LT:W #100 lt? [ 'Terminal_too_narrow! s:put nl bye ] if
LT:H #27 lt? [ 'Terminal_too_short! s:put nl bye ] if
~~~
# Dependencies
Load depenencies from the library.
~~~
{ 'konilo 'termina 'tob } &library:load a:for-each
~~~
# Configure UI Colors
~~~
:dss:label (-) fg:red ;
:dss:value (-) fg:yellow ;
:dss:sep (-) fg:cyan ;
:dss:prompt (-) bg:blue fg:white ;
~~~
# Utilities
I intend for takawiri to provide a variety of useful tools to
aid in using RetroForth interactively.
This word provides access to retro-describe(1).
~~~
:describe (s-)
'retro-describe_"%s" s:format file:R unix:popen
[ dup file:read dup c:put n:zero? ] until unix:pclose ;
~~~
# Watchlist
The watchlist will allow monitoring a small number of addresses
in the right panel of the interface. A use case might be to
do something like:
'Base &Base watch
'Compiler &Compiler watch
~~~
{ 'Add_Zero
'Heap____
'Compiler
'________
'________
} 'WatchlistLabels d:create #5 , &, a:for-each
'Watchlist d:create #5 ,
#0 ,
&Heap ,
&Compiler ,
#5 allot
:watch (sa-) drop-pair ;
:unwatch (a-) drop ;
:watchlist (-)
#19 #5 [ dup #84 vt:row,col
dss:label &WatchlistLabels over #19 n:sub a:fetch s:put sp
dss:value &Watchlist over #19 n:sub a:fetch
fetch n:put n:inc vt:reset ] times drop ;
~~~
# UI
First are words to display the text output buffer.
~~~
:bar:right (-) dss:sep TOB:H n:inc [ I n:inc TOB:W #2 n:add vt:row,col $| c:put ] indexed-times vt:reset ;
:bar:bottom (-) dss:sep TOB:H n:inc #1 vt:row,col TOB:W n:inc [ $= c:put ] times $+ c:put vt:reset ;
:display:tob (-) tob:display bar:right bar:bottom ;
~~~
Draw the section separators.
~~~
:length (-n) LT:W TOB:W #4 n:add n:sub ;
:--- (n-) [ $- c:put ] times sp ;
:sections (-)
dss:sep
#6 TOB:W #4 n:add vt:row,col length ---
#12 TOB:W #4 n:add vt:row,col length ---
#18 TOB:W #4 n:add vt:row,col length ---
vt:reset ;
~~~
~~~
'Items d:create #0 comma #32 allot
:dss
[ depth #5 n:min !Items
&Items fetch-next [ store-next ] times drop
&Items a:reverse [ ] a:for-each
#0 &Items [
over n:inc #6 n:add #84 vt:row,col
dss:label
over n:zero? [ 'TOS:___ s:put ] [ '_______ s:put ] choose
vt:reset
n:put
n:inc ] a:for-each
drop ] gc ;
~~~
This is the start of code to display temporary strings on the
data stack. The plan is to have it show below the stack values,
in a format like:
<depth> <first XX characters>
The <depth> data will match up to the values in the stack disp.
Note: this won't be useful until after the alternate `s:evaluate`
is done.
~~~
:ss/later (-)
#0 &Items [ dup STRINGS gt? [ over n:inc #12 n:add #84 vt:row,col s:put ] &drop choose n:inc ] a:for-each drop
;
~~~
~~~
:layout:stat,col (-n) #84 ;
:layout:stat (sn-) layout:stat,col vt:row,col dss:label s:put dss:value ;
:stats
'HERE:__ #1 layout:stat here n:put
'FREE:__ #2 layout:stat FREE n:put
'DEPTH:_ #3 layout:stat depth n:put
'ROW:___ #4 layout:stat @TY n:put
'COL:___ #5 layout:stat @TX n:put
vt:reset
;
#1 #2 #3 #4 #5
:prompt (-)
dss:prompt
LT:H #1 vt:row,col LT:W [ sp ] times
LT:H #1 vt:row,col '>>_ s:put ;
~~~
Start of work on a new input model. The current one uses
`s:evaluate`, which works, but burns through the temporary
strings pool. For this to be practical, I need to avoid doing
that, so it's time to write a replacement.
~~~
'InputStream d:create #1025 allot
'Len var
'At var
:end? (-f) @At @Len gt? ;
:c:get-from-input (-c)
&InputStream @At fetch &At v:inc end? [ &c:get unhook ] if ;
:s:get/input s:get &InputStream s:copy &c:get-from-input &c:get set-hook ;
~~~
~~~
:ui
&err:notfound unhook
&banner tob:with
[ vt:reset vt:clear vt:home
display:tob
sections
stats dss (ss watchlist
prompt s:get vt:reset
[ dup s:put nl s:evaluate ] tob:with
] forever ;
ui
~~~
================================================================
Things needed:
- termios device & words (or add termios to unix device?)
- colors for interface elements
- write a better alternative to `s:evaluate` to avoid consuming
the temporary string space
- refactor & document everything
================================================================