From f4e3b95ea37ff595b3859c1bd465a7144cf6fc80 Mon Sep 17 00:00:00 2001 From: crc Date: Wed, 13 Feb 2019 00:58:25 +0000 Subject: [PATCH] initial version of new block editor FossilOrigin-Name: 31e1e3f3355e94633b37ea882052c9adbdf20de7866e72e850b815b2c8e0ab37 --- example/Block-Editor.forth | 268 +++++++++++++++++++++++++++++++++++++ 1 file changed, 268 insertions(+) create mode 100755 example/Block-Editor.forth diff --git a/example/Block-Editor.forth b/example/Block-Editor.forth new file mode 100755 index 0000000..5353423 --- /dev/null +++ b/example/Block-Editor.forth @@ -0,0 +1,268 @@ +#!/usr/bin/env retro + +# A Block Editor + +I've written numerous block editors over the years. This is a +new one that I'm planning to eventually use with Retro/Native. + +This presents a visual, (briefly) modal interface. + + 0---------1---------2---------3---------4---------5---------6--- + | This is the new block editor! | + * | | + | | + | | + | | + | | + | | + | | + | | + | | + | | + | | + | | + | | + | | + | | + 0---------1---------2---------3---------4---------5---------6--- + * #2 1:0 + +The horizontal rulers have column indicators, there are cursor +position indicators (and the actual cursor location shows at the +intersection). The bottom right has the current block number, +line number, and column number. + +Key Bindings + + | Key | Action | + | --- | ------------------------------ | + | H | Save and select previous block | + | S | Save and select next block | + | h | Move cursor left | + | t | Move cursor down | + | n | Move cursor up | + | s | Move cursor right | + | i | Save the current block | + | y | Reload the current block | + | a | Edit text | + | c | Move cursor to prior word | + | r | Move cursor to next word | + | 1 | Evaluate the current block | + | x | Erase the current block | + | q | Save the Blocks and Quit | + +The key bindings are oriented around the Dvorak keyboard layout +which I use. The key map leverages an approach I stole from +Samuel Falvo II's VIBE editor: the key handlers are words in +the dictionary with a format like: + + editor:key<*> + +With the `*` being the key. + +# Configuration + +I define the number of blocks and the file to use. On the non +hosted Retro systems the block file will be replaced by a +block storage device. + +~~~ +#512 'BLOCKS const +'retro.blocks 'BLOCK-FILE s:const +~~~ + +# Variables + +I am keeping some data in variables. This will include the +current block number, the current line, and the current row. + +~~~ +'CurrentBlock var +'CurrentLine var +'CurrentCol var +~~~ + +# Buffers + +I have one memory region for the current block and a second +one for the entire set of blocks. I keep the blocks in RAM +for performance. + +~~~ +'Block d:create #1025 allot + +'Blocks d:create + BLOCKS #1024 * allot +~~~ + +# Block File I/O + +This should be replaced with the block storage device once +that is added to Nga. + +~~~ +:blocks:initialize (-) + &Blocks #1024 BLOCKS * [ #32 over store n:inc ] times drop ; + +:block:write (-) + &Blocks BLOCK-FILE file:open + BLOCKS #1024 * [ over fetch over file:write &n:inc dip ] times + file:close drop ; + +:block:read (-) + &Blocks BLOCK-FILE file:open swap + [ dup-pair file:read swap store &n:inc dip ] times + file:close drop ; +~~~ + +These are used to load a block into the active buffer and +copy it back to the full set. + +~~~ +{{ + :current-block @CurrentBlock #1024 * &Blocks + ; + :next [ n:inc ] bi@ ; + :copy dup-pair fetch swap store ; +---reveal--- + :block:select (n-) + !CurrentBlock + [ &Block buffer:set + current-block #1024 + [ fetch-next buffer:add ] times drop ] buffer:preserve ; + + :block:update (-) + current-block &Block #1024 [ copy next ] times drop-pair ; +}} +~~~ + +# Block Display + +This is fairly long, but mostly due to my desire to have a +more complex display with column and cursor indicators. +It should be pretty straightforward though. + +~~~ +:clear #27 c:put '[2J s:put #27 c:put '[0;0H s:put ; +{{ + :ruler + '____0---------1---------2---------3 s:put + '---------4---------5---------6--- s:put nl ; + :pad-to-cur @CurrentCol dup [ sp ] times ; + :pad-to-eol #64 swap - [ sp ] times ; + :indicator '____ s:put pad-to-cur $* c:put pad-to-eol ; + :block# $# c:put @CurrentBlock n:put ; + :pos @CurrentLine n:put $: c:put @CurrentCol n:put ; + :status block# sp pos nl dump-stack nl ; + :current? I @CurrentLine eq? ; + :left [ $* c:put ] &sp choose ; + :format current? left '_|_ s:put call '_| s:put nl ; + :line [ #64 [ fetch-next c:put ] times ] format ; + :code &Block #16 [ line ] times drop ; +---reveal--- + :block:display (-) + clear ruler code ruler indicator status ; +}} +~~~ + +# The Editor Core + +~~~ +{{ + :clear #27 c:put '[0;0H s:put ; + + :cursor + ASCII:ESC c:put + $[ c:put @CurrentLine #2 + n:put + $; c:put @CurrentCol #5 + n:put $H c:put ; + + :handler + c:get + 'editor:key<_> [ #11 + store ] sip d:lookup + dup n:-zero? [ d:xt fetch call ] [ drop ] choose ; + +---reveal--- + + :edit + blocks:initialize block:read #0 block:select + 'stty_cbreak unix:system clear + repeat block:display cursor handler again ; +}} +~~~ + +# The Rest + +# Key Handlers + +All of the actual work is done by the words that make up +the key handlers. + +~~~ +{{ + 'Tokens d:create #4097 allot +---reveal--- + :editor:key<1> + &Tokens #4096 [ #0 over store n:inc ] times drop + &Heap [ &Tokens !Heap &Block #32 s:tokenize ] v:preserve + [ dup s:length n:zero? [ drop ] [ interpret ] choose ] set:for-each ; +}} + +:clear #27 c:put '[0;0H s:put ; + +:editor:key block:update @CurrentBlock n:dec #0 BLOCKS n:dec n:limit block:select clear ; +:editor:key block:update @CurrentBlock n:inc #0 BLOCKS n:dec #18 &nl times dump-stack n:limit block:select clear ; +:editor:key &CurrentLine v:dec &CurrentLine #0 #15 v:limit ; +:editor:key &CurrentCol v:dec &CurrentCol #0 #63 v:limit ; +:editor:key &CurrentCol v:inc &CurrentCol #0 #63 v:limit ; +:editor:key &CurrentLine v:inc &CurrentLine #0 #15 v:limit ; + +{{ + :cursor + ASCII:ESC c:put + $[ c:put @CurrentLine #2 + n:put + $; c:put @CurrentCol #5 + n:put $H c:put ; +---reveal--- + :editor:key cursor s:get @CurrentLine #64 * @CurrentCol + &Block + over s:length [ dup-pair &fetch dip store &n:inc bi@ ] times drop-pair #27 c:put '[2J s:put ; +}} + +:editor:key block:update block:write ; +:editor:key @CurrentBlock block:select ; +:editor:key &Block #1024 [ #32 over store n:inc ] times drop ; +:editor:key block:write 'stty_-cbreak unix:system #0 unix:exit ; +~~~ + +~~~ +{{ + :limit (n-n) &Block dup #1024 + n:limit ; + + :fetch-prior (a-Ac) [ n:dec ] [ fetch ] bi ; + + :find-next-word + @CurrentLine #63 * @CurrentCol + &Block + n:inc + repeat fetch-next #32 -eq? 0; drop again ; + + :find-prior-word + @CurrentLine #63 * @CurrentCol + &Block + n:dec + repeat fetch-prior #32 -eq? 0; drop again ; + + :select-next (-) + find-next-word n:dec limit &Block - + #63 /mod !CurrentLine !CurrentCol ; + + :select-prior (-) + find-prior-word n:inc limit &Block - + #63 /mod !CurrentLine !CurrentCol ; + +---reveal--- + + :editor:key select-prior ; + + :editor:key select-next ; +}} +~~~ + + +# Run It + +~~~ +edit +~~~