\ Copyright 2021 Bradley D. Nelson \ \ Licensed under the Apache License, Version 2.0 (the "License"); \ you may not use this file except in compliance with the License. \ You may obtain a copy of the License at \ \ http://www.apache.org/licenses/LICENSE-2.0 \ \ Unless required by applicable law or agreed to in writing, software \ distributed under the License is distributed on an "AS IS" BASIS, \ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. \ See the License for the specific language governing permissions and \ limitations under the License. ( Lazy loaded visual editor. ) : visual r| also DEFINED? termios [IF] termios [THEN] also internals also ansi also forth current @ vocabulary visual visual definitions vocabulary insides insides definitions 256 constant max-path create filename max-path allot 0 value filename# 0 value fileh 10 constant start-size start-size allocate throw value text start-size value capacity 0 value length 0 value caret : up ( n -- n ) begin dup 0 > over text + c@ nl <> and while 1- repeat 1- 0 max ; : nup ( n -- n ) 10 for up next ; : down ( n -- n ) begin dup length < over text + c@ nl <> and while 1+ repeat 1+ length min ; : ndown ( n -- n ) 10 for down next ; : update caret nup dup 0<> if 1+ 1+ then { before } before ndown ndown { after } page text before + caret before - crtype caret length < text caret + c@ nl <> and if 1 bg text caret + c@ emit normal text caret + 1+ after caret - 1- 0 max crtype else 1 bg space normal text caret + after caret - crtype then normal ; : insert ( ch -- ) length capacity = if text capacity 1+ 2* >r r@ 1+ resize throw to text r> to capacity then text caret + dup 1+ length caret - cmove> text caret + c! 1 +to caret 1 +to length update ; : handle-esc key dup [char] [ = if drop key dup [char] A = if drop caret up to caret update exit then dup [char] B = if drop caret down to caret update exit then dup [char] C = if drop caret 1+ length min to caret update exit then dup [char] D = if drop caret 1- 0 max to caret update exit then dup [char] 5 = if drop key drop caret 8 for up next to caret update exit then dup [char] 6 = if drop key drop caret 8 for down next to caret update exit then drop exit then drop ; : delete length caret > if text caret + dup 1+ swap length caret - 1- 0 max cmove -1 +to length update then ; : backspace caret 0 > if -1 +to caret delete then ; : load ( a n -- ) 0 to caret dup to filename# filename swap cmove filename filename# r/o open-file 0= if to fileh fileh file-size throw to capacity text capacity 1+ resize throw to text capacity to length text length fileh read-file throw drop fileh close-file throw else drop 0 to capacity 0 to length then ; : save filename filename# w/o create-file throw to fileh text length fileh write-file throw fileh close-file throw ; : quit-edit page filename filename# type cr ." SAVE? " begin key 95 and dup [char] Y = if drop save 123 throw then dup [char] N = if drop 123 throw then drop again ; : handle-key ( ch -- ) dup 27 = if drop handle-esc exit then dup [char] D [char] @ - = if delete exit then dup [char] H [char] @ - = over 127 = or if drop backspace exit then dup [char] L [char] @ - = if drop update exit then dup [char] S [char] @ - = if drop save update exit then dup [char] X [char] @ - = if drop quit-edit then dup [char] Q [char] @ - = if drop quit-edit then dup 13 = if drop nl insert exit then dup bl >= if insert else drop then ; : ground depth 0<> throw ; : step *key handle-key ground ; DEFINED? raw-mode 0= [IF] : raw-mode ; : normal-mode ; [THEN] : run raw-mode update begin ['] step catch dup 123 = if drop normal-mode page exit then if ." FAILURE!" then again ; visual definitions insides : edit () bl parse load run ; previous previous previous previous current ! visual | evaluate ;
Legal: site web personnel sans commerce / personal site without seling