crc/retroforth
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

takawiri: watchlist code is now functional

Browse source 
FossilOrigin-Name: 45caf4048b7cdec5aec3fe333b0fdc43b7152fb19ba78ab822b586d52701de40
This commit is contained in:
crc 2024-03-14 13:47:10 +00:00
parent 35f3a4d141
commit a019adeeb3
1 changed files with 24 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
takawiri.retro
View file

@ -73,31 +73,37 @@ The watchlist will allow monitoring a small number of addresses
in the right panel of the interface. A use case might be to in the right panel of the interface. A use case might be to
do something like: do something like:
'Base &Base watch &Base 'Base watch
'Compiler &Compiler watch &Compiler 'Compiler watch
~~~ ~~~
{ '________ 'Watchlist d:create #5 , #-1 , #-1 , #-1 , #-1 , #-1 ,
'________ 'WatchlistLabels d:create #5 , #-1 , #-1 , #-1 , #-1 , #-1 ,
'________
'________
'________
} 'WatchlistLabels d:create #5 , &, a:for-each
'Watchlist d:create #5 , &Heap , #-1 , #-1 , #-1 , #-1 ,
:watchlist:find (a-n) :watchlist:find (a-n)
dup &Watchlist a:contains? [ drop #-1 ] -if; dup &Watchlist a:contains? [ drop #-1 ] -if;
&Watchlist swap a:index ; &Watchlist swap a:index ;
:watch (sa-) s:keep drop-pair ; :watchlist:make-label (s-s)
dup s:length #8 gt? [ #8 s:left ] if
dup s:length #8 lt?
[ dup s:length #8 swap n:sub [ '_ s:append ] times ] if
s:keep ;
:watch (as-)
watchlist:make-label
#-1 watchlist:find &Watchlist &WatchlistLabels
'abcde 'adcbec reorder a:store a:store ;
:unwatch (a-) :unwatch (a-)
watchlist:find dup n:positive? [ drop ] -if watchlist:find dup n:positive? &drop -if
&Watchlist #-1 'abc 'acab reorder a:store ; [ &Watchlist #-1 'abc 'acab reorder a:store ]
[ &WatchlistLabels #-1 'abc 'acab reorder a:store ] bi ;
:watchlist (-) :watchlist (-)
#19 #5 [ dup #84 vt:row,col #19 #5 [ dup #84 vt:row,col
dss:label &WatchlistLabels over #19 n:sub a:fetch s:put sp dss:label &WatchlistLabels over #19 n:sub a:fetch
dup #-1 -eq? [ s:put sp ] [ drop '_________ s:put ] choose
dss:value &Watchlist over #19 n:sub a:fetch dss:value &Watchlist over #19 n:sub a:fetch
dup n:positive? [ fetch ] [ drop #0 ] choose dup n:positive? [ fetch ] [ drop #0 ] choose
n:put n:inc vt:reset ] times drop ; n:put n:inc vt:reset ] times drop ;
@ -128,14 +134,15 @@ Draw the section separators.
~~~ ~~~
'Items d:create #0 comma #32 allot 'Items d:create #0 comma #32 allot
:tos? over n:zero? ;
:dss :dss
[ depth #5 n:min !Items [ depth #5 n:min !Items
&Items fetch-next [ store-next ] times drop &Items fetch-next &store-next times drop
&Items a:reverse [ ] a:for-each &Items a:reverse [ ] a:for-each
#0 &Items [ #0 &Items [
over n:inc #6 n:add #84 vt:row,col over n:inc #6 n:add #84 vt:row,col
dss:label dss:label
over n:zero? [ 'TOS:___ s:put ] [ '_______ s:put ] choose tos? [ 'TOS:___ s:put ] [ '_______ s:put ] choose
vt:reset vt:reset
n:put n:put
n:inc ] a:for-each n:inc ] a:for-each
@ -172,8 +179,6 @@ is done.
vt:reset vt:reset
; ;
#1 #2 #3 #4 #5
:prompt (-) :prompt (-)
dss:prompt dss:prompt
LT:H #1 vt:row,col LT:W [ sp ] times LT:H #1 vt:row,col LT:W [ sp ] times