wls@astrovax.UUCP (William L. Sebok) (08/05/84)
In my original Forth posting I forgot to delete reference to a simple forth
screen editor I wrote. I hadn't included it because I had not yet made it
understand the /etc/termcap file, and thus felt it was not really finished.
However due to many requests I am posting it anyway. This editor requires
the utf translation program that was included in the Forth distribution. It
should be extracted in the same directory as the forth distribution was
extracted.
Terminals are described by termcap-like files written in forth. Some terminal
features not described in /etc/termcap are used here.
Enjoy,
Bill Sebok astrovax!wls
-------------------------
echo "extracting edit"
utf <<'!E!O!T!' >edit
( Screen Editor Define storage for functions 1/23/82 W.Sebok )
?;S EDIT VOCABULARY EDITING EDITING DEFINITIONS
: STR VARIABLE DOES> @ ?DUP IF COUNT TYPE THEN ;
STR $INIT STR $EXIT VARIABLE ?BNDLCK
STR $LF STR $RT STR $UP STR $DN
STR $CLR STR $HOME
STR $<FNC STR $FNC> STR $HFNC STR $VFNC
STR $LBFNC STR $RBFNC STR $RUFNC
STR $INSCH STR $DELCH
STR $OPNLN STR $DELLN STR $CLRLN STR $WIPE
VARIABLE %CRS VARIABLE %DOCUM
-->
( Screen Editor Block #2 1/23/82 W.Sebok )
VARIABLE PXX VARIABLE PYY
: CLR-BLK BLOCK UPDATE DUP 1024 32 FILL 0X! ;
: UP PYY 1-! PYY @ 0< IF PYY 0X! ELSE $UP THEN ;
: LFT PXX 1-! PXX @ 0< IF PXX 0X! ELSE $LF THEN ;
: RT PXX @ 63 < IF PXX 1+! $RT THEN ;
: DN PYY @ 15 < IF PYY 1+! $DN THEN ;
: OCH DUP EMIT PYY @ LINE UPDATE PXX @ + C! PXX @ 63 < IF
PXX 1+! ELSE $LF THEN ;
: 3RT 0CR $RT $RT $RT PXX 0X! ;
: CRSADD 3 + SWAP 1+ SWAP %CRS @ EXECUTE ;
: FENCES 16 PYY @ DO 0CR I 2 .R $<FNC $VFNC $FNC> $DN LOOP
$LF $<FNC $LBFNC 64 SSPACES SLOC 64 ' $HFNC @ 1+ C@ FILL S.
$RBFNC 16 PYY @ DO $UP $LF $VFNC LOOP $FNC> 3RT PXX 0X! ;
-->
( Draw Screen Boundaries )
CREATE NMBSTR " \n 0\r\n 1\r\n 2\r\n 3\r\n 4\r\n 5\r\n 6\r\n 7"
" \r\n 8\r\n 9\r\n10\r\n11\r\n12\r\n13\r\n14\r\n15" // S,
: NUMBS $HOME NMBSTR COUNT TYPE ;
: BNDAR DUP -1 CRSADD $<FNC $VFNC 64 CRSADD $VFNC $FNC> ;
: FENCES 0 -1 CRSADD $<FNC 16 0 DO $VFNC $DN $LF LOOP $LBFNC
64 0 DO $HFNC LOOP $RBFNC -1 0 CRSADD 64 0 DO $HFNC LOOP
$RUFNC 16 0 DO $DN $LF $VFNC LOOP $FNC> ;
: REDRAW 16 PYY @ DO I 0 CRSADD I LINE 64 TYPE LOOP ;
: REFRESH PYY 0X! PXX 0X! $INIT $CLR KEY> 16 0 DO CR
3 SPACES I LINE 64 -TRAILING TYPE LOOP %DOCUM @ ?DUP IF CR
EXECUTE THEN <KEY $HOME FENCES NUMBS $HOME SCR @ 3 .R 0
0 CRSADD ; -->
( Screen Editor Block #3 1/23/82 W.Sebok )
: CLRLN ' $CLRLN @ IF $CLRLN ELSE 0CR 67 SPACES 0CR THEN ;
: %INSCH PYY @ LINE UPDATE PXX @ + DUP DUP 1+ 63 PXX @ -
CMOVE 32 OVER C! ' $INSCH @ IF DROP $INSCH ?BNDLCK @ IF EXIT
THEN PYY @ 64 CRSADD $<FNC $VFNC $FNC> SPACE ELSE
64 PXX @ - -TRAILING TYPE THEN PYY @ PXX @ CRSADD ;
: %DELCH PYY @ LINE UPDATE DUP PXX @ + DUP 1+ OVER 63 PXX @ -
CMOVE SWAP 63 + 32 SWAP C! ' $DELCH @ IF DROP $DELCH ?BNDLCK
@ IF EXIT THEN PYY @ 63 CRSADD SPACE $<FNC $VFNC $FNC>
ELSE 63 PXX @ - -TRAILING 1+ 64 MIN TYPE THEN
PYY @ PXX @ CRSADD ;
-->
( Screen Editor Block #4 1/23/82 W.Sebok )
: %OPNLN " " PYY @ 1- EDITOR I PYY @ PXX @ ' $OPNLN @ IF
$OPNLN OVER BNDAR 16 0 CRSADD $DELLN NUMBS ELSE REDRAW THEN
CRSADD ;
: %INSLN SDUP PYY @ 1- EDITOR I PYY @ PXX @ ' $OPNLN @ IF
$OPNLN OVER 0 CRSADD 'SS COUNT -TRAILING TYPE OVER BNDAR
16 0 CRSADD $DELLN NUMBS ELSE REDRAW THEN CRSADD ;
: %DELLN SDROP PYY @ EDITOR D PYY @ PXX @ ' $DELLN @ IF
$DELLN 15 0 CRSADD $OPNLN 15 BNDAR NUMBS ELSE REDRAW THEN
CRSADD ;
: %CR 3RT DN ;
: %TAB 8 PXX @ 8 MOD - 0 DO RT LOOP ;
: %PANIC EMPTY-BUFFERS REFRESH ;
: %DEL PXX 0> IF LFT 32 OCH LFT THEN ;
-->
( More Operations )
: WIPE ' $WIPE @ IF $WIPE ?BNDLCK @ IF EXIT THEN PYY @ 64
CRSADD $<FNC $VFNC $FNC> ELSE 64 PXX @ - SPACES THEN
PYY @ PXX @ CRSADD ;
: %WIPE PYY @ LINE UPDATE PXX @ + 64 PXX @ - 32 FILL WIPE ;
: %JOIN PYY @ 15 < IF PYY @ LINE PXX @ S@ PYY @ 1+ LINE 64 S@
// SDUP 64 1 SUBSTR EDITOR PYY @ R SLEN 64 - 65 SUBSTR PYY
@ 1+ R PYY @ PXX @ OVER LINE 3RT 64 TYPE OVER 1+ LINE $DN 3RT
64 TYPE DUP PXX ! CRSADD UPDATE THEN ;
: %BREAK PYY @ LINE UPDATE SDROP PXX @ + 64 PXX @ - S@ %WIPE
PYY @ 15 < IF DN %INSLN UP THEN ;
: %EXIT 22 -3 CRSADD $EXIT KEY> SDROP QUIT ;
-->
( Screen Editor Block #4 1/23/82 W.Sebok )
LOADF <keys/strokes ( get input strokes )
LOADF <termcap/strokes ( get output characters )
FORTH DEFINITIONS
: CLR-BLK BLOCK UPDATE DUP 1024 32 FILL 0X! ;
: EDIT SCR ! " " <KEY EDITING REFRESH BEGIN 0KEY 127 AND
DUP 127 < OVER 31 > AND IF OCH ELSE SEARCH ?DUP IF EXECUTE
ELSE BELL THEN THEN 0 UNTIL ;
FORTH ;S
!E!O!T!
mkdir termcap keys
echo "extracting termtype"
utf <<'!E!O!T!' >termtype
( Return Type of Terminal 3/14/82 W.Sebok )
" TERMTYPE" SFIND #IF TERMTYPE ;S #THEN
" TERM" GETENV #IF ;S #THEN
CR ." Type of Terminal (Enter Number):" CR
." 1) Televideo" CR
." 2) Zenith" CR
." 3) VT100 or Retrographics" CR
." ? " IASK
DUP 1 = #IF : TERMTYPE " tvi950" ; TERMTYPE DROP ;S #THEN
DUP 2 = #IF : TERMTYPE " zenith" ; TERMTYPE DROP ;S #THEN
DUP 3 = #IF : TERMTYPE " vt100" ; TERMTYPE DROP ;S #THEN
CR ." Unrecognized Terminal!!" ABORT
!E!O!T!
echo "extracting termcap/strokes"
utf <<'!E!O!T!' >termcap/strokes
( Load Appropriate Output strings for desired terminal 3/14/82)
: STR! ?DUP IF HERE SWAP ! S, EXIT THEN SDROP ;
" <termcap/" LOADF <termtype // SLOADF
;S
: DMBCRS $HOME ?DUP IF 0 DO $RT LOOP THEN ?DUP IF 0 DO $DN
LOOP THEN ; ( Default Dumb cursor addressing routine )
' DMBCRS %CRS !
!E!O!T!
echo "extracting termcap/adm5"
utf <<'!E!O!T!' >termcap/adm5
( Terminal Capabilities for Adm 5 6/27/83 W.Sebok )
find $UP " \K" STR! find $DN " \J" STR!
find $RT " \L" STR! find $LF " \H" STR!
find $CLR " \Z" STR! find $HOME " \036" STR!
find $LBFNC " +" STR! find $RBFNC " +" STR!
find $RUFNC " +" STR!
find $HFNC " -" STR! find $VFNC " |" STR!
: ADMCRS <# 32 + HOLD 32 + HOLD 61 HOLD 27 HOLD 0. #> TYPE ;
' ADMCRS %CRS ! ( Cursor Addressing )
-->
( Self/documentation of keystrokes for Adm 5 6/27/83 WLS )
: ADMDOCUM CR ."
exit: ^C tab: ^I panic : ^P"
CR ."
For movement use arrow keys"
CR ."
insert char ^E del char ^D insert line ^O del line ^X"
CR ."
break line: ^B join line: ^G wipe line : ^U"
CR ."
rplc line: ^R"
;
' ADMDOCUM %DOCUM !
;S
!E!O!T!
echo "extracting termcap/h19"
utf <<'!E!O!T!' >termcap/h19
( Terminal Capabilities for Heathkit Z19 1/25/82 W.Sebok )
find $INIT " \et" STR! find $EXIT " \eu" STR!
find $UP " \eA" STR! find $DN " \eB" STR!
find $RT " \eC" STR! find $LF " \b" STR!
find $CLR " \eE" STR! find $HOME " \eH" STR!
find $<FNC " \eF" STR! find $FNC> " \eG" STR!
find $RUFNC " c" STR! find $LBFNC " e" STR!
find $RBFNC " d" STR!
find $HFNC " a" STR! find $VFNC " `" STR!
find $INSCH " \e@ \eO\b" STR!
find $DELCH " \eN" STR!
find $OPNLN " \eL" STR! find $DELLN " \eM" STR!
find $CLRLN " \r\eK" STR! find $WIPE " \eK" STR!
: ZENADD <# 32 + HOLD 32 + HOLD 89 HOLD 27 HOLD 0. #> TYPE ;
' ZENADD %CRS ! ( Cursor Addressing ) -->
( Self/documentation of keystrokes for Heath H19 2/28/83 WLS )
: H19DOCUM CR ."
exit: ^C tab: ^I panic : red"
CR ."
right: right arrow up: up arrow"
CR ."
down: down arrow left: left arrow"
CR ."
insert char: IC del char: DC insert line: IL del line : DL"
CR ."
break line: ^B join line: ^J wipe line : ^U rplc line: ^R"
;
' H19DOCUM %DOCUM !
;S
!E!O!T!
ln termcap/h19 termcap/h19us
ln termcap/h19 termcap/zenith
echo "extracting termcap/tvi950"
utf <<'!E!O!T!' >termcap/tvi950
( Terminal Capabilities for TeleVideo 950 1/23/82 W.Sebok )
find ?BNDLCK #if 1 ?BNDLCK ! #then
find $UP " \K" STR! find $DN " \V" STR!
find $RT " \L" STR! find $LF " \b" STR!
find $CLR " \Z" STR! find $HOME " \^" STR!
find $<FNC " \e.0\e$" STR! find $FNC> " \e%\e.3" STR!
find $LBFNC " E" STR! find $RBFNC " H" STR!
find $RUFNC " G" STR!
find $HFNC " K" STR! find $VFNC " J" STR!
find $INSCH " \e&\eQ\e'" STR! find $DELCH " \e&\eW\e'" STR!
find $OPNLN " \eE" STR! find $DELLN " \eR" STR!
find $CLRLN " \r\eT" STR! find $WIPE " \e&\eT\e'" STR!
: TLVCRS <# 32 + HOLD 32 + HOLD 61 HOLD 27 HOLD 0. #> TYPE ;
' TLVCRS %CRS ! ( Cursor Addressing )
-->
( Self/documentation of keystrokes for Heath H19 2/28/83 WLS )
: TVIDOCUM CR ."
exit: ^C tab: ^I panic : page erase"
CR ."
For movement use arrow keys"
CR ."
Use Keys: insert char del char insert line del line"
CR ."
break line: ^B join line: ^J wipe line : ^U"
CR ."
rplc line: shift line insert"
;
' TVIDOCUM %DOCUM !
;S
!E!O!T!
echo "extracting termcap/tvi970"
utf <<'!E!O!T!' >termcap/tvi970
( Terminal Capabilities for TeleVideo 970 10/17/83 W.Sebok )
find ?BNDLCK #if 0 ?BNDLCK ! #then
find $INIT " \e)0\e[?9h" STR! find $EXIT " \e)B" STR!
find $UP " \K" STR! find $DN " \V" STR!
find $RT " \L" STR! find $LF " \b" STR!
find $CLR " \^\Z" STR! find $HOME " \^" STR!
find $<FNC " \N" STR! find $FNC> " \O\e(B" STR!
find $LBFNC " m" STR! find $RBFNC " j" STR!
find $RUFNC " k" STR!
find $HFNC " q" STR! find $VFNC " x" STR!
find $INSCH " \e[@" STR! find $DELCH " \e[P" STR!
find $OPNLN " \e[L" STR! find $DELLN " \e[M" STR!
find $CLRLN " \e[2K" STR! find $WIPE " \e[K" STR!
: VTADDR SWAP " \[[" 1+ (.) S@ // " ;" // 1+ (.) S@ // " H" //
S. ; ' VTADDR %CRS !
-->
( Self/documentation of keystrokes for tvi970 2/28/83 WLS )
: TVIDOCUM CR ."
exit: ^C tab: ^I panic : page erase"
CR ."
For movement use arrow keys"
CR ."
Use Keys: insert char del char insert line del line"
CR ."
break line: ^B join line: ^J wipe line : ^U"
CR ."
rplc line: shift line insert"
;
' TVIDOCUM %DOCUM !
;S
!E!O!T!
ln termcap/tvi970 termcap/tvi970D
ln termcap/tvi970 termcap/tvi970E
echo "extracting termcap/vt100"
utf <<'!E!O!T!' >termcap/vt100
( Terminal Capabilities for vt100 1/25/82 W.Sebok )
find $INIT " \e)0" STR! find $EXIT " \e)B" STR!
find $UP " \e[A" STR! find $DN " \J" STR!
find $RT " \e[C" STR! find $LF " \H" STR!
find $CLR " \e[H\e[J" STR! find $HOME " \e[H" STR!
find $<FNC " \N" STR! find $FNC> " \O" STR!
find $RUFNC " k" STR! find $LBFNC " m" STR!
find $RBFNC " j" STR!
find $HFNC " q" STR! find $VFNC " x" STR!
find $CLRLN " \r\e[K" STR! find $WIPE " \e[K" STR!
: VTADDR SWAP " \[[" 1+ (.) S@ // " ;" // 1+ (.) S@ // " H" //
S. ;
' VTADDR %CRS ! ( Cursor Addressing )
-->
( Self/documentation of keystrokes for vt100 2/28/83 WLS )
: VTDOCUM CR ."
exit: ^C tab: ^I panic : ^P"
CR ."
right: right arrow up: up arrow"
CR ."
down: down arrow left: left arrow"
CR ."
insert char: PF2 del char: PF1 insert line: PF3 del line: PF4"
CR ."
break line: ^B join line: ^J wipe line : ^U rplc line: ^R"
;
' VTDOCUM %DOCUM !
;S
!E!O!T!
ln termcap/vt100 termcap/vt100rvs
echo "extracting keys/strokes"
utf <<'!E!O!T!' >keys/strokes
( Create keystroke string Tree 1/22/82 W.Sebok )
VARIABLE TREE
: TRERR ." Illegal tree!!" ABORT ;
( " str" addr TRNOD construct tree node )
( Format: char ; child pointer ; brother pointer ; action )
: TRNOD ?DUP 0= IF SDROP EXIT THEN TREE DUP @ IF ( first) @
BEGIN DUP C@ SLOC C@ = IF ++ DUP @ IF SLEN 1- 2 SUBSTR
SLEN 0= IF TRERR THEN @ 0 ELSE TRERR THEN ELSE ++ ++ DUP @
IF @ 0 ELSE 1 THEN THEN UNTIL THEN SLEN 0 DO HERE SWAP !
SLOC I + C@ , 0 , 0 , DUP , HERE 3 A- LOOP 2DROP SDROP ;
( needs raw mode 1st char on stack, return action addr or 0 )
: SEARCH TREE @ BEGIN 2DUP C@ = IF ++ DUP @ IF -DROP 0KEY
127 AND SWAP @ 0 ELSE ++ ++ @ 1 THEN ELSE ++ ++ @ DUP 0= THEN
UNTIL -DROP ;
" <keys/" LOADF <termtype // SLOADF
;S
!E!O!T!
echo "extracting keys/adm5"
utf <<'!E!O!T!' >keys/adm5
( Keystroke/function assignments for Adm 5 6/27/83 WLS )
" \r" FIND %CR TRNOD
" \?" FIND %DEL TRNOD
" \U" FIND %WIPE TRNOD
" \C" FIND %EXIT TRNOD
" \t" FIND %TAB TRNOD
" \P" FIND %PANIC TRNOD
" \E" FIND %INSCH TRNOD " \D" FIND %DELCH TRNOD
" \L" FIND RT TRNOD " \H" FIND LFT TRNOD
" \J" FIND DN TRNOD " \K" FIND UP TRNOD
" \O" FIND %OPNLN TRNOD " \R" FIND %INSLN TRNOD
" \X" FIND %DELLN TRNOD
" \G" FIND %JOIN TRNOD " \B" FIND %BREAK TRNOD
;S
!E!O!T!
echo "extracting keys/h19"
utf <<'!E!O!T!' >keys/h19
( Keystroke/function assignments for Heath t19 1/22/82 WLS )
" \r" FIND %CR TRNOD
" \?" FIND %DEL TRNOD
" \U" FIND %WIPE TRNOD
" \C" FIND %EXIT TRNOD
" \I" FIND %TAB TRNOD
" \eQ" FIND %PANIC TRNOD
" \e@" FIND %INSCH TRNOD " \eN" FIND %DELCH TRNOD
" \eC" FIND RT TRNOD " \eD" FIND LFT TRNOD
" \eB" FIND DN TRNOD " \eA" FIND UP TRNOD
" \eL" FIND %OPNLN TRNOD " \R" FIND %INSLN TRNOD
" \eM" FIND %DELLN TRNOD
" \B" FIND %BREAK TRNOD " \J" FIND %JOIN TRNOD
;S
!E!O!T!
ln keys/h19 keys/h19us
ln keys/h19 keys/zenith
echo "extracting keys/tvi950"
utf <<'!E!O!T!' >keys/tvi950
( Keystroke/function assignments for TeleVideo 1/22/82 WLS )
" \r" FIND %CR TRNOD
" \?" FIND %DEL TRNOD
" \U" FIND %WIPE TRNOD
" \C" FIND %EXIT TRNOD
" \t" FIND %TAB TRNOD
" \eY" FIND %PANIC TRNOD
" \eQ" FIND %INSCH TRNOD " \eW" FIND %DELCH TRNOD
" \L" FIND RT TRNOD " \H" FIND LFT TRNOD
" \V" FIND DN TRNOD " \K" FIND UP TRNOD
" \eE" FIND %OPNLN TRNOD " \eN" FIND %INSLN TRNOD
" \eR" FIND %DELLN TRNOD
" \J" FIND %JOIN TRNOD " \B" FIND %BREAK TRNOD
;S
!E!O!T!
echo "extracting keys/tvi970"
utf <<'!E!O!T!' >keys/tvi970
( Keystroke/function assignments for tvi970 10/17/82 WLS )
" \r" FIND %CR TRNOD
" \?" FIND %DEL TRNOD
" \U" FIND %WIPE TRNOD
" \C" FIND %EXIT TRNOD
" \I" FIND %TAB TRNOD
" \e[U" FIND %PANIC TRNOD
" \e[@" FIND %INSCH TRNOD " \e[P" FIND %DELCH TRNOD
" \e[C" FIND RT TRNOD " \e[D" FIND LFT TRNOD
" \e[B" FIND DN TRNOD " \e[A" FIND UP TRNOD
" \e[L" FIND %OPNLN TRNOD " \e[Q" FIND %INSLN TRNOD
" \e[M" FIND %DELLN TRNOD
" \B" FIND %BREAK TRNOD " \J" FIND %JOIN TRNOD
;S
!E!O!T!
ln keys/tvi970 keys/tvi970D
ln keys/tvi970 keys/tvi970E
echo "extracting keys/vt100"
utf <<'!E!O!T!' >keys/vt100
( Keystroke/function assignments for vt100 1/22/82 WLS )
" \r" FIND %CR TRNOD
" \?" FIND %DEL TRNOD
" \U" FIND %WIPE TRNOD
" \C" FIND %EXIT TRNOD
" \I" FIND %TAB TRNOD
" \P" FIND %PANIC TRNOD
" \eOQ" FIND %INSCH TRNOD " \eOP" FIND %DELCH TRNOD
" \e[C" FIND RT TRNOD " \e[D" FIND LFT TRNOD
" \e[B" FIND DN TRNOD " \e[A" FIND UP TRNOD
" \eOR" FIND %OPNLN TRNOD " \R" FIND %INSLN TRNOD
" \eOS" FIND %DELLN TRNOD
" \B" FIND %BREAK TRNOD " \J" FIND %JOIN TRNOD
;S
!E!O!T!
exit
-----Cut here. If this line is missing something got lost-----------
--
Bill Sebok Princeton University, Astrophysics
{allegra,akgua,burl,cbosgd,decvax,ihnp4,noao,princeton,vax135}!astrovax!wls