165 lines
4.2 KiB
Forth
165 lines
4.2 KiB
Forth
\ 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 ( <filename> ) bl parse load run ;
|
|
|
|
previous previous previous previous current ! visual
|
|
| evaluate ;
|