2024-01-19 18:40:14 +01:00
|
|
|
#!/usr/bin/env retro
|
|
|
|
|
2024-01-19 14:11:51 +01:00
|
|
|
================================================================
|
|
|
|
_ _ _ _
|
|
|
|
| |_ __ _| | ____ ___ _(_)_ __(_) crc's new listener for
|
|
|
|
| __/ _` | |/ / _` \ \ /\ / / | '__| | RetroForth
|
|
|
|
| || (_| | < (_| |\ V V /| | | | |
|
|
|
|
\__\__,_|_|\_\__,_| \_/\_/ |_|_| |_| ** UNDER DEVELOPMENT **
|
|
|
|
|
|
|
|
================================================================
|
|
|
|
|
2024-01-20 19:57:15 +01:00
|
|
|
# Terminal Configuration
|
|
|
|
|
2024-01-22 17:49:17 +01:00
|
|
|
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).
|
2024-01-20 19:57:15 +01:00
|
|
|
|
2024-01-22 17:49:17 +01:00
|
|
|
~~~
|
|
|
|
ioctl:term-size (rows,cols) 'LT:W const 'LT:H const
|
|
|
|
~~~
|
2024-01-22 14:20:08 +01:00
|
|
|
|
2024-02-21 20:42:28 +01:00
|
|
|
Setup the text output buffer dimensions. The width is currently
|
|
|
|
fixed at 80 columns; the height is set based on the terminal
|
|
|
|
height.
|
|
|
|
|
|
|
|
~~~
|
|
|
|
#80 'TOB:W const
|
|
|
|
LT:H #2 - 'TOB:H const
|
|
|
|
~~~
|
|
|
|
|
|
|
|
Check to make sure the terminal is large enough to display
|
|
|
|
everything.
|
|
|
|
|
2024-01-20 19:57:15 +01:00
|
|
|
~~~
|
2024-01-22 17:49:17 +01:00
|
|
|
LT:W #100 lt? [ 'Terminal_too_narrow! s:put nl bye ] if
|
2024-01-23 03:47:08 +01:00
|
|
|
LT:H #27 lt? [ 'Terminal_too_short! s:put nl bye ] if
|
2024-01-20 19:57:15 +01:00
|
|
|
~~~
|
|
|
|
|
|
|
|
# Dependencies
|
|
|
|
|
2024-01-23 03:47:08 +01:00
|
|
|
Load dependencies from the library.
|
2024-01-19 14:11:51 +01:00
|
|
|
|
|
|
|
~~~
|
|
|
|
{ 'konilo 'termina 'tob } &library:load a:for-each
|
|
|
|
~~~
|
|
|
|
|
2024-01-22 14:20:08 +01:00
|
|
|
# Configure UI Colors
|
|
|
|
|
|
|
|
~~~
|
|
|
|
:dss:label (-) fg:red ;
|
2024-01-22 15:47:32 +01:00
|
|
|
:dss:value (-) fg:yellow ;
|
|
|
|
:dss:sep (-) fg:cyan ;
|
2024-01-22 14:20:08 +01:00
|
|
|
:dss:prompt (-) bg:blue fg:white ;
|
|
|
|
~~~
|
|
|
|
|
2024-01-20 19:57:15 +01:00
|
|
|
# Utilities
|
2024-01-20 19:25:24 +01:00
|
|
|
|
|
|
|
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 ;
|
|
|
|
~~~
|
|
|
|
|
2024-01-20 19:57:15 +01:00
|
|
|
# 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
|
|
|
|
|
|
|
|
~~~
|
2024-03-08 19:33:35 +01:00
|
|
|
{ '________
|
|
|
|
'________
|
|
|
|
'________
|
2024-01-20 19:57:15 +01:00
|
|
|
'________
|
|
|
|
'________
|
2024-01-20 20:06:04 +01:00
|
|
|
} 'WatchlistLabels d:create #5 , &, a:for-each
|
2024-01-20 19:57:15 +01:00
|
|
|
|
2024-03-08 19:33:35 +01:00
|
|
|
'Watchlist d:create #5 , &Heap , #-1 , #-1 , #-1 , #-1 ,
|
|
|
|
|
|
|
|
:watchlist:find (a-n)
|
|
|
|
dup &Watchlist a:contains? [ drop #-1 ] -if;
|
|
|
|
&Watchlist swap a:index ;
|
|
|
|
|
|
|
|
:watch (sa-) s:keep drop-pair ;
|
|
|
|
:unwatch (a-)
|
|
|
|
watchlist:find dup n:positive? [ drop ] -if
|
|
|
|
&Watchlist #-1 'abc 'acab reorder a:store ;
|
2024-01-20 19:57:15 +01:00
|
|
|
|
2024-01-20 20:06:04 +01:00
|
|
|
:watchlist (-)
|
|
|
|
#19 #5 [ dup #84 vt:row,col
|
2024-01-22 15:47:32 +01:00
|
|
|
dss:label &WatchlistLabels over #19 n:sub a:fetch s:put sp
|
|
|
|
dss:value &Watchlist over #19 n:sub a:fetch
|
2024-03-08 19:33:35 +01:00
|
|
|
dup n:positive? [ fetch ] [ drop #0 ] choose
|
|
|
|
n:put n:inc vt:reset ] times drop ;
|
2024-01-20 19:57:15 +01:00
|
|
|
~~~
|
|
|
|
|
2024-01-22 14:20:08 +01:00
|
|
|
# UI
|
2024-01-19 14:11:51 +01:00
|
|
|
|
2024-01-22 14:20:08 +01:00
|
|
|
First are words to display the text output buffer.
|
2024-01-19 18:40:14 +01:00
|
|
|
|
2024-01-19 14:11:51 +01:00
|
|
|
~~~
|
2024-01-22 15:47:32 +01:00
|
|
|
: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 ;
|
2024-01-22 14:20:08 +01:00
|
|
|
:display:tob (-) tob:display bar:right bar:bottom ;
|
2024-01-19 18:40:14 +01:00
|
|
|
~~~
|
2024-01-19 14:11:51 +01:00
|
|
|
|
2024-01-22 15:47:32 +01:00
|
|
|
Draw the section separators.
|
|
|
|
|
|
|
|
~~~
|
|
|
|
:length (-n) LT:W TOB:W #4 n:add n:sub ;
|
|
|
|
:--- (n-) [ $- c:put ] times sp ;
|
|
|
|
:sections (-)
|
|
|
|
dss:sep
|
2024-01-23 03:47:08 +01:00
|
|
|
#3 [ I n:inc #6 n:mul TOB:W #4 n:add vt:row,col length --- ]
|
|
|
|
indexed-times
|
2024-01-22 15:47:32 +01:00
|
|
|
vt:reset ;
|
|
|
|
~~~
|
|
|
|
|
2024-01-19 18:40:14 +01:00
|
|
|
~~~
|
2024-01-19 14:11:51 +01:00
|
|
|
'Items d:create #0 comma #32 allot
|
|
|
|
|
|
|
|
:dss
|
2024-01-20 19:25:24 +01:00
|
|
|
[ depth #5 n:min !Items
|
2024-01-19 14:11:51 +01:00
|
|
|
&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 ;
|
2024-01-20 19:25:24 +01:00
|
|
|
~~~
|
|
|
|
|
|
|
|
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:
|
2024-01-19 14:11:51 +01:00
|
|
|
|
2024-01-20 19:25:24 +01:00
|
|
|
<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.
|
|
|
|
|
|
|
|
~~~
|
2024-01-20 20:06:04 +01:00
|
|
|
:ss/later (-)
|
2024-01-20 19:25:24 +01:00
|
|
|
#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
|
|
|
|
;
|
|
|
|
~~~
|
|
|
|
|
|
|
|
~~~
|
2024-01-19 18:40:14 +01:00
|
|
|
:layout:stat,col (-n) #84 ;
|
|
|
|
:layout:stat (sn-) layout:stat,col vt:row,col dss:label s:put dss:value ;
|
|
|
|
|
2024-01-19 14:11:51 +01:00
|
|
|
:stats
|
2024-01-19 18:40:14 +01:00
|
|
|
'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
|
2024-01-19 14:11:51 +01:00
|
|
|
vt:reset
|
|
|
|
;
|
|
|
|
|
|
|
|
#1 #2 #3 #4 #5
|
|
|
|
|
2024-01-19 18:40:14 +01:00
|
|
|
:prompt (-)
|
2024-01-20 19:57:15 +01:00
|
|
|
dss:prompt
|
2024-01-22 12:21:09 +01:00
|
|
|
LT:H #1 vt:row,col LT:W [ sp ] times
|
|
|
|
LT:H #1 vt:row,col '>>_ s:put ;
|
2024-01-19 18:40:14 +01:00
|
|
|
~~~
|
|
|
|
|
|
|
|
~~~
|
2024-01-23 16:48:11 +01:00
|
|
|
:quit ioctl:set-lbreak vt:reset bye ;
|
|
|
|
:bye quit ;
|
2024-01-19 18:40:14 +01:00
|
|
|
~~~
|
|
|
|
|
|
|
|
~~~
|
2024-01-19 14:11:51 +01:00
|
|
|
:ui
|
|
|
|
&err:notfound unhook
|
2024-01-23 16:48:11 +01:00
|
|
|
ioctl:set-cbreak
|
2024-01-19 14:11:51 +01:00
|
|
|
&banner tob:with
|
2024-01-22 15:47:32 +01:00
|
|
|
[ vt:reset vt:clear vt:home
|
2024-01-22 14:20:08 +01:00
|
|
|
display:tob
|
2024-01-22 15:47:32 +01:00
|
|
|
sections
|
|
|
|
stats dss (ss watchlist
|
2024-01-23 16:48:11 +01:00
|
|
|
prompt s:get-word vt:reset
|
|
|
|
[ dup s:put sp interpret ] tob:with
|
2024-01-19 14:11:51 +01:00
|
|
|
] forever ;
|
|
|
|
|
|
|
|
ui
|
|
|
|
~~~
|
|
|
|
|
|
|
|
================================================================
|
|
|
|
|
|
|
|
Things needed:
|
|
|
|
|
|
|
|
- termios device & words (or add termios to unix device?)
|
|
|
|
- colors for interface elements
|
|
|
|
- refactor & document everything
|
|
|
|
|
|
|
|
================================================================
|