This is a port of the RetroForth/ilo block editor to RetroForth/nga. Much of this will be the same as the original implementation, but there are some differences. Retro/nga provides three words for interfacing with a block store: block:set-file (s-) block:read (na-) block:write (na-) This begins by using these to implement the `block:load` and `block:save`. The initial block store is set to `ilo.blocks`. ~~~ 'ilo.blocks block:set-file :block:load block:read ; :block:save block:write ; ~~~ In Retro/ilo, the memory is constrained to 65,536 cells, with a defined memory map. Since Retro/nga does not do this, the block buffer is allocated inline. ~~~ #0 , 'block:buffer d:create #1025 allot ~~~ Variables to track the current block and the number of blocks are provided. Alter the `Blocks` count to match your actual data store limits. ~~~ 'Block var #128 'Blocks var-n ~~~ `e:line` displays a line from the block buffer. ~~~ :e:line (n-) #64 n:mul block:buffer n:add #64 [ fetch-next c:put ] times drop nl ; ~~~ :e:for-each-line (q-) #16 [ block:buffer I #64 n:mul #64 s:middle swap &call sip ] indexed-times drop ; ~~~ {{ :sep sp sp sp #6 [ '+----5---- s:put ] times '+--- s:put nl ; :l/n I dup #10 lt? &sp if n:put sp ; :line l/n I e:line ; :lines #16 &line indexed-times ; :block# 'Editing_# s:put @Block n:put '_of_ s:put @Blocks n:dec n:put nl ; ---reveal--- :list* nl #16 [ I e:line ] indexed-times ; :list# nl lines ; :list nl sep lines sep block# ; }} ~~~ ~~~ &list 'e:Display var-n {{ :constrain @Block #0 #4095 n:limit !Block ; ---reveal--- :set &Block store constrain ; :save &Block fetch block:buffer block:save ; :load &Block fetch block:buffer block:load ; :next &Block v:inc constrain load ; :prev &Block v:dec constrain load ; :new block:buffer #1024 [ #32 swap store-next ] times drop ; :edit set load @e:Display call ; }} ~~~ ~~~ :e:to-line #64 n:mul block:buffer n:add ; :e:erase/line e:to-line #32 swap #64 [ dup-pair store n:inc ] times drop-pair ; :e:replace &e:to-line dip [ over store n:inc ] s:for-each drop ; :e:replace-at [ &e:to-line dip n:add ] dip [ over store n:inc ] s:for-each drop ; :e:insert dup e:erase/line s:get e:replace ; :e:insert-at s:get e:replace-at ; :0 #0 e:insert ; :1 #1 e:insert ; :2 #2 e:insert ; :3 #3 e:insert ; :4 #4 e:insert ; :5 #5 e:insert ; :6 #6 e:insert ; :7 #7 e:insert ; :8 #8 e:insert ; :9 #9 e:insert ; :10 #10 e:insert ; :11 #11 e:insert ; :12 #12 e:insert ; :13 #13 e:insert ; :14 #14 e:insert ; :15 #15 e:insert ; ~~~ ~~~ :run &block:buffer s:evaluate ; :use (block) set load run ; :using (first,last) over n:sub swap set load run [ next run ] times ; ~~~ `titles` iterates through the blocks, displaying the title (first line) of any block that does not start with a blank space. ~~~ {{ :setup #64 block:buffer n:dec store ; :has-description? block:buffer fetch #32 -eq? ; :display [ I n:put tab #0 e:line ] if ; :describe I set load has-description? display ; :save &Block fetch ; :restore &Block store load ; ---reveal--- :titles save setup @Blocks &describe indexed-times restore ; }} ~~~ {{ 'Hash var :reset #64 block:buffer n:dec store ; :actual block:buffer n:dec dup #32 s:index/c s:left ; :code? block:buffer fetch $( eq? ; ---reveal--- :needs (s-) @Hash [ @Block swap s:hash !Hash @Blocks [ I set load reset code? [ actual s:hash @Hash eq? &run if ] if ] indexed-times !Block load ] dip !Hash ; }}