145 lines
3.3 KiB
Forth
Executable file
145 lines
3.3 KiB
Forth
Executable file
#!/usr/bin/env retro
|
|
|
|
================================================================
|
|
_ _ _ _
|
|
| |_ __ _| | ____ ___ _(_)_ __(_) crc's new listener for
|
|
| __/ _` | |/ / _` \ \ /\ / / | '__| | RetroForth
|
|
| || (_| | < (_| |\ V V /| | | | |
|
|
\__\__,_|_|\_\__,_| \_/\_/ |_|_| |_| ** UNDER DEVELOPMENT **
|
|
|
|
================================================================
|
|
|
|
~~~
|
|
#80 'TOB:W const
|
|
#23 'TOB:H const
|
|
~~~
|
|
|
|
Load depenencies from the library.
|
|
|
|
~~~
|
|
{ 'konilo 'termina 'tob } &library:load a:for-each
|
|
~~~
|
|
|
|
# tools
|
|
|
|
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 ;
|
|
~~~
|
|
|
|
# ui
|
|
|
|
Configure the UI colors.
|
|
|
|
~~~
|
|
:dss:label (-) fg:red ;
|
|
:dss:value (-) fg:cyan ;
|
|
:dss:sep (-) fg:blue ;
|
|
:dss:prompt (-) fg:magenta ;
|
|
~~~
|
|
|
|
~~~
|
|
:~left dss:sep #23 [ I n:inc #82 vt:row,col $| c:put ] indexed-times vt:reset ;
|
|
:~bottom dss:sep #24 #1 vt:row,col #81 [ $= c:put ] times $+ c:put 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 (-)
|
|
#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 #25 #1 vt:row,col '>>_ s:put vt:reset ;
|
|
|
|
~~~
|
|
|
|
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:clear vt:home tob:display
|
|
~left stats dss (ss
|
|
~bottom
|
|
prompt s:get
|
|
[ 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
|
|
|
|
================================================================
|