This is a port of the Konilo block editor to RetroForth. Much of this will be the same as the original implementation, but there are a few small differences. RetroForth 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 (:na-) block:read ; :block:save (:na-) block:write ; ~~~ In Konilo, 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. Additionally, under Konilo, the cell preceeding the block buffer is used as a count. I allocate two extra cells and patch the block buffer starting address manually. ~~~ 'block:buffer d:create #1026 allot &block:buffer n:inc @Dictionary d:xt store ~~~ 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 (:-a) 'Variable;_current_block_number add-description #128 'Blocks var-n (:-a) 'Variable;_number_of_blocks_in_block_store add-description ~~~ `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# ; }} ~~~ The next several words are for navigating through and saving blocks. +------+----+----------------------------------------------+ | Word | | Description | +======+====+==============================================+ | set | n- | Set the current block to 'n' | | load | | (Re)load the current block | | next | | Load the next block | | prev | | Load the previous block | | new | | Erase the contents of the block buffer | | edit | n- | Set the current block to 'n', load & list it | +------+----+----------------------------------------------+ ~~~ &list 'e:Display var-n {{ :constrain @Block #0 @Blocks n:dec n:limit !Block ; ---reveal--- :set (:n-) &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 (:n-) 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 ; ~~~ To run the code in the block buffer, execute `run`. This makes use of `s:evaluate` from Konilo, where strings are arrays. ~~~ {{ 'max-length var 'source var 'index var 'token d:create #65 allot :eoi? &index &max-length &fetch bi@ gt? ; :eow? &token fetch &token n:add fetch [ #32 eq? ] [ #0 eq? ] bi or ; :set-input #0 &index store [ &source store ] [ a:length &max-length store ] bi ; :get-char &source fetch &index fetch a:fetch &token v:inc &index v:inc &token fetch &token n:add store ; :parse-word #0 &token store [ get-char eow? eoi? or ] until &token dup v:dec ; :count-words #1 swap [ #32 eq? &n:inc if ] a:for-each ; :valid? dup a:length n:-zero? ; :s:evaluate &set-input &count-words bi [ parse-word valid? [ a:to-string interpret ] &drop choose ] times ; ---reveal--- :run (:-) &block:buffer n:dec #1024 over store s:evaluate ; }} ~~~ +-------+-----+--------------------------------------------+ | Word | | Description | +=======+=====+============================================+ | use | n- | Load and run the code in block "n" | | using | fl- | Load and run the code in blocks "f" to "l" | +-------+-----+--------------------------------------------+ ~~~ :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 ; }} ~~~ `needs` takes a string with a block identifier and loads/runs code in any block matching this. Example: '(doubles) needs Would load any blocks containing "(doubles)" as the initial token in their index line. Tokens after the first one are ignored. So the above would match: (doubles) (constants) (doubles) (variables) but not: (singles) (constants) ~~~ {{ 'Hash var :reset #64 block:buffer n:dec store ; :actual block:buffer n:dec dup #32 a:index a:left a:to-string ; :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 ; }} ~~~