Unterschiede

Hier werden die Unterschiede zwischen zwei Versionen angezeigt.

--- papierkorb:ledit.blk [2025-08-16 17:50] – ↷ Seite von projects:ledit.blk nach papierkorb:ledit.blk verschoben mka
+++ papierkorb:ledit.blk [Unbekanntes Datum] (aktuell) – gelöscht - Externe Bearbeitung (Unbekanntes Datum) 127.0.0.1
@@ Zeile 1: / Zeile 1: @@
-===DOSEDIT style forth input line editor===
-<code>
-Screen 0 not modified
-
-\ Last change:   Screen  029                   14:33JWB03/03/87
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-Screen 1 not modified
-\ LEDIT LOAD SCREEN                            11:29JWB11/23/85
-
-ONLY FORTH DEFINITIONS ALSO
-
-     : LTASK ;
-
-     2  35  THRU
-
-
-
-
-
-
-
-
-
-Screen 2 not modified
-\ Line editor variables                        09:49JWB02/07/86
-
-ONLY EDITOR ALSO FORTH DEFINITIONS
-
-VARIABLE %MOD   \ Type-over/Insert flag.   True=Insert.
-VARIABLE %BUF   \ Address of line buffer.
-VARIABLE %MLEN  \ Length of line buffer.
-VARIABLE %OFF   \ Offset to start of line.
-VARIABLE %ROW   \ Current row or vertical position on screen.
-VARIABLE %POS   \ Current position in the line.
-VARIABLE %DONE  \ Finished flag.  If true then quit.
-VARIABLE LKEY   \ Last key code pressed.
-
-
-
-
-Screen 3 not modified
-\ #R  POS@                                     09:49JWB02/07/86
-
-: #R    ( --  n )  \ Leave n, characters to right of cursor.
-
-         %MLEN @    \ Fetch length of line buffer.
-         %POS @     \ Fetch current cursor position.
-         - ;        \ Subtract leaving number of characters to
-                    \ right of cursor.
-
-: POS@  ( --  adr ) \ Leave address of current cursor position.
-
-         %BUF @     \ Fetch address of line buffer.
-         %POS @     \ Fetch current cursor position.
-         + ;        \ Add leaving current address of cursor.
-
-
-Screen 4 not modified
-\ CUR                                          09:49JWB02/07/86
-
-: CUR   ( row col   -- ) \ Position cursor at  (col,row)
-
-         80 MOD          \ Calculate column position.
-         SWAP            \ Bring row to top of stack.
-         25 MOD          \ Calculate row position.
-         GOTOXY ;        \ Word that positions cursor.
-
-
-
-
-
-
-
-
-Screen 5 not modified
-\ .POS                                         09:49JWB02/07/86
-
-: .POS  ( --   -- ) \ Move cursor to its current position.
-
-         %POS @      \ Fetch current position in line.
-         %MLEN @     \ Fetch length of line buffer.
-         MOD         \ Divide leaving cursor position.
-         %OFF @ +    \ Fetch offset to start of line and add
-                     \ to cursor position.
-         %ROW @      \ Fetch current row.
-         SWAP        \ Put (col,row) in proper order for CUR
-         CUR ;       \ Position cursor at (col,row).
-
-
-
-
-Screen 6 not modified
-\ !POS  +POS                                   09:49JWB02/07/86
-
-: !POS  ( n    -- ) \ Set current position to n.
-
-         %MLEN @ MOD   \ Take top stack value and divide by
-                       \ length of line buffer, leaving remainder
-         %POS ! ;      \ which is stored at current position in
-                       \ line.
-
-: +POS  ( n    -- ) \ Increment current position by n.
-
-         %POS @ +      \ Fetch current position in line and add
-         !POS ;        \ value "n" to it. Store back at current
-                       \ position in line.
-
-
-Screen 7 not modified
-\ +.POS  HOM                                   09:49JWB02/07/86
-
-: +.POS ( n    -- ) \ Increment by n and display at new location
-
-         +POS        \ Increments current position by "n"
-         .POS ;      \ Moves cursor to its current position.
-
-
-: HOM   ( --   -- )     \ To begining of line, type-over mode.
-
-         %POS OFF    \ Set current position in line to zero.
-         .POS        \ Move cursor to current position in line.
-         %MOD OFF ;  \ Set insert mode to false.
-
-
-
-Screen 8 not modified
-\ !CHAR  ECHO                                  09:49JWB02/07/86
-
-: !CHAR ( char   -- )   \ Store character at current position.
-
-         POS@ C!     \ Fetch address of current cursor position
-                     \ and store character there.
-         1 +.POS ;   \ Increment cursor position by one and
-                     \ display at new location.
-
-: ECHO  ( char   -- )   \ Echo character and store character.
-
-         DUP  (CONSOLE)  \ Output character to console device.
-         !CHAR ;         \ Store character at current position.
-
-
-
-Screen 9 not modified
-\ CTYPE                                        09:49JWB02/07/86
-
-: CTYPE  ( adr cnt   -- ) \ Send string to console only.
-
-         0 ?DO           \ Set up loop with character count.
-             COUNT       \ Fetch char from adr and increment
-                         \ adr by one.
-             (CONSOLE)   \ Output char to current console device.
-           LOOP          \ Loop back.
-           DROP ;        \ Clean up stack.
-
-
-
-
-
-
-Screen 10 not modified
-\ .LIN                                         09:49JWB02/07/86
-
-: .LIN  ( --   -- )     \ Update entire line.
-         %POS @     \ Fetch current position in line.
-         HOM        \ Move cursor to beginning of line.
-         %BUF @     \ Fetch address of line buffer.
-         %MLEN @    \ Fetch length of line buffer.
-         CTYPE      \ Output entire line buffer to console.
-         %POS !     \ Restore previous cursor position in line
-         .POS   ;   \ and move cursor to the current position.
-
-
-
-
-
-
-Screen 11 not modified
-\ RUB                                          09:49JWB02/07/86
-
-: RUB   ( --   -- )     \ Rub out character behind cursor.
-
-         -1 +.POS     \ Decrement current cursor position by one
-         BL  ECHO     \ Store a blank and echo to console.
-         -1 +.POS ;   \ Echo incremented cursor position by one
-                      \ so we must decrement by one again.
-
-
-
-
-
-
-
-
-Screen 12 not modified
-\ MEOL                                         09:49JWB02/07/86
-
-: MEOL  ( --   -- )     \ Move to end of line.
-
-         %BUF @ %MLEN @  \ Get address and length of line buffer.
-         -TRAILING       \ Leave length excluding trailing spaces
-         %MLEN @ 1- MIN  \ Leave line buffer length minus one
-                         \ or string length whichever is smaller.
-         !POS DROP .POS  \ Move cursor to that position.
-         %MOD OFF ;      \ Turn off insert mode.
-
-
-
-
-
-
-Screen 13 not modified
-\ DEOL  DEALL                                  09:49JWB02/07/86
-
-: DEOL  ( --   -- )     \ Delete to end of field.
-
-         POS@  #R   \ Get cursor position leaving number of
-                    \ characters to right of cursor.
-         BL FILL    \ Blanks from right of cursor to end of line.
-         .LIN ;     \ Update entire line.
-
-
-: DEALL ( --   -- )     \ Delete entire line.
-
-         %BUF @ %MLEN @  \ Get address and length of line buffer.
-         BL FILL         \ Fill line with blanks.
-         .LIN            \ Update entire line.
-         HOM ;           \ Move cursor to beginning of line.
-Screen 14 not modified
-\ DCHAR                                        09:49JWB02/07/86
-
-\ Delete character at cursor position and close gap created.
-: DCHAR ( --   -- )
-
-         POS@ 1+ POS@            \ From adr and To adr
-         #R MOVE                 \ Number to move, move string
-         BL %BUF @ %MLEN @ 1- + C! \ Put blank in line buf at eol
-         POS@ #R -TRAILING       \ Cursor position and number of
-                                 \ char less trailing blanks.
-         1+ CTYPE                \ Add one to cursor and send
-         .POS ;                  \ string to console. Move cursor
-                                 \ to current position.
-
-
-
-Screen 15 not modified
-\ ICHAR                                        09:49JWB02/07/86
-
-\ Insert character char  at current position and update display.
-: ICHAR ( char   -- )
-
-         #R >R POS@ DUP R@ + 1- C@ BL =  \ Blank at end of line?
-         IF   DUP 1+  R@ 1-      \ Yes, set up from adr to adr.
-              MOVE POS@ C!       \ Move string, insert character.
-              POS@ R@ -TRAILING  \ Strip off trailing blanks.
-              CTYPE   1 +.POS    \ Output to console and move
-                                 \ cursor one to right.
-         ELSE BEEP 2DROP         \ No, beep then clean up stack.
-         THEN R> DROP ;          \ Clean up return and parameter
-                                 \ stack.
-
-
-Screen 16 not modified
-\ OVER-STRIKE  INSERT                          09:49JWB02/07/86
-
-: OVER-STRIKE ( --  -- )  \ Set over-strike mode.
-
-   %MOD @ IF             \ If insert mode then
-   LITTLE-CURSOR         \ set cursor to small
-   %MOD OFF              \ set over-strike mode
-   THEN ;                \ otherwise continue.
-
-
-: INSERT     ( --  -- )   \ Set insert mode.
-
-   %MOD @ NOT IF         \ If over-strike mode then
-   BIG-CURSOR            \ set cursor to large
-   %MOD ON               \ set insert mode
-   THEN ;                \ otherwise continue.
-Screen 17 not modified
-\ L-ARROW  R-ARROW  CLR                        09:49JWB02/07/86
-
-: L-ARROW  ( --  -- )      \ Move cursor left one position.
-         -1 +.POS OVER-STRIKE ;
-
-: R-ARROW  ( --  -- )      \ Move cursor right one position.
-         1 +.POS OVER-STRIKE ;
-
-
-: CLR  ( --  -- )          \ Clear screen, & redisplay at home.
-
-   0 0 79 24 15 INIT-WINDOW  \ Clear screen.
-   %ROW OFF   .LIN ;        \ Update entire first line.
-
-
-
-Screen 18 not modified
-\ INSS  +TRANS   -TRANS                        10:05JWB02/07/86
-
-: INSS ( --  -- )          \ Insert/overstrike  toggle.
-    %MOD @ IF  OVER-STRIKE  ELSE  INSERT THEN ;
-
-: +TRANS ( --  -- )    \
-         %POS @ %MLEN @ 1- <     \ Cursor at end of line?
-         IF  POS@  @ 256 /MOD    \ Transpose two char at cursor.
-             ECHO  ECHO          \ Echo and store both char.
-             L-ARROW             \ Reposition cursor.
-         THEN ;                  \
-
-
-: -TRANS ( --  -- )
-         %POS @
-         IF -1 +.POS  +TRANS L-ARROW  THEN ;
-Screen 19 not modified
-\ BK.PTR  PR.PTR                               09:50JWB02/07/86
-256 CONSTANT BK.SIZE    \ Size of command line backup buffer.
-     VARIABLE BK.PTR     \ Pointer to top of backup buffer.
-     VARIABLE PR.PTR     \ Pointer to previous line in bkup buf.
-     CREATE   BK.BUF  BK.SIZE ALLOT    \ This is the backup buf.
-\ Leave address of the top of the backup buffer.
-: BK.ADR ( --  adr )
-         BK.BUF  BK.PTR @ + ;
-
-\ Increment pointer to top of backup buffer by n.
-: +BK.PTR ( n  -- ) BK.PTR +! ;
-\ Leave address of the previous line.
-: PR.ADR ( --  adr )
-         BK.BUF  PR.PTR @ + ;
-\ Increment pointer to previous line by n.
-: +PR.PTR ( n  -- )  PR.PTR +! ;
-Screen 20 not modified
-\ DELETE-1ST-LINE  NO-ROOM?  MAKE-ROOM         09:50JWB02/07/86
-\ Delete first line in backup buffer and adjust pointer counts.
-: DELETE-1ST-LINE ( --  -- )
-         BK.BUF 1+ C@ 2+ >R
-         BK.BUF R@ + BK.BUF  BK.PTR @ R@ - CMOVE
-         R> NEGATE DUP +BK.PTR  +PR.PTR  ;
-
-\ Leave a true flag if there is no room for string of size n.
-: NO-ROOM?  ( n   flag )
-        2+ BK.SIZE  BK.PTR @  -  <  NOT ;
-
-\ Delete lines till there is room for string of size n.
-: MAKE-ROOM ( n   -- )
-         BEGIN  DUP  NO-ROOM?
-         WHILE  DELETE-1ST-LINE
-         REPEAT DROP ;
-Screen 21 not modified
-\ SAVE-LINE                                    09:50JWB02/07/86
-   VARIABLE   RLFLAG
-
-: RLFLAG?  RLFLAG @ ;
-
-\ Save current line in the backup buffer.
-: SAVE-LINE ( --  -- )
-    %BUF @ %MLEN @ -TRAILING ?DUP        \ adr & count of line
-    IF   DUP MAKE-ROOM                   \ Make room if required
-         BK.ADR OFF  DUP BK.ADR 1+ C!    \ Save line count.
-         TUCK BK.ADR 2+ SWAP CMOVE       \ Move the line.
-         2+   +BK.PTR                    \ Update pointers.
-         BK.PTR @ PR.PTR !
-         RLFLAG  ON
-    ELSE DROP  THEN  ;
-
-Screen 22 not modified
-\ <LINE   >LINE                                09:50JWB02/07/86
-\ Decrement previous line pointer to start of the previous line.
-: <LINE    ( -- -- )
-         PR.PTR @ 0 <=                   \ At bottom of bkup buf?
-         IF   BK.PTR @ PR.PTR !  THEN    \ If so point to top!!
-         BEGIN -1 +PR.PTR  PR.ADR C@     \ Now back up one line.
-         0= UNTIL ;
-
-\ Increment previous line pointer to start of the next line.
-: >LINE    ( --  -- )
-         PR.PTR @  BK.PTR @ <            \ Not at top of bk buf?
-         IF BEGIN  1 +PR.PTR  PR.ADR C@  \ Then move forward one
-            0= UNTIL                     \ line in bkup buf.
-         THEN
-         PR.PTR @ BK.PTR @ >=            \ Did we reach the top?
-         IF PR.PTR OFF  THEN  ;          \ If so point to bottom.
-Screen 23 not modified
-\ RECALL-LINE  -RECALL-LINE +RECALL-LINE       11:27JWB11/23/85
-\ Move previous line to the editing buffer.
-: RECALL-LINE ( --  -- )
-       %BUF @ %MLEN @ BL FILL            \ Clear editing buffer.
-       RLFLAG?
-       IF    PR.ADR  1+
-             COUNT %MLEN @ MIN   \ From adr and count.
-             %BUF @ SWAP CMOVE   \ To adr and moveit.
-       THEN .LIN MEOL   ;        \ Display & move to end.
-\ Back up one line and move it to editing buffer.
-: -RECALL-LINE ( --  -- )
-    RLFLAG? IF <LINE THEN   RECALL-LINE ;
-\ Move forward one line then move it to the editing buffer.
-: +RECALL-LINE ( --  -- )
-    RLFLAG? IF >LINE THEN  RECALL-LINE ;
-
-Screen 24 not modified
-\ Read screen location.  SC@                   18:06JWB11/25/85
-ALSO
-CODE  SC@   ( --  char )
-         8 #  AH MOV
-           BH BH SUB 16 INT AH AH SUB
-        128 # AX CMP
-U>= IF  32 # AL MOV  THEN
-         31 # AX CMP
-U<  IF  32 # AL MOV  THEN
-                 1PUSH END-CODE  PREVIOUS
-: +MARK  ( n  -- )
-         CUR@ 0 ROT  AT ATRIB @ SC@
-         112 ATRIB ! VEMIT ATRIB ! CUR! ;
-: -MARK  ( n  -- )
-         CUR@ 0 ROT  AT SC@  VEMIT   CUR! ;
-
-Screen 25 not modified
-\  READ-SCREEN                                 15:21JWB11/25/85
-  VARIABLE SLINE
-: SINC   SLINE @ 1+   25 MOD SLINE ! ;
-: SDEC   SLINE @ 24 + 25 MOD SLINE ! ;
-
-  CREATE SLINE-BUF   80 ALLOT
-
-\ Copy line n of screen into SLINE-BUF .
-: READ-SCREEN  ( n  -- )
-         25 MOD  CUR@ >R
-         80 0 DO  I OVER AT SC@
-                  SLINE-BUF I + C!
-              LOOP  DROP
-         R> CUR!  ;
-
-
-Screen 26 not modified
-\                                              09:50JWB02/07/86
-\ Recall next line from screen.
-: +RECALL-SLINE  ( --  -- )
-    NO-CURSOR
-    SLINE @ -MARK SINC SLINE @ DUP +MARK READ-SCREEN
-    %BUF @ %MLEN @ BL FILL
-    SLINE-BUF 79 -TRAILING %MLEN @ MIN %BUF @ SWAP CMOVE
-    .LIN  MEOL  LITTLE-CURSOR ;
-
-\ Recall previous line from screen.
-: -RECALL-SLINE ( --  -- )
-    NO-CURSOR
-    SLINE @ -MARK SDEC SLINE @ DUP +MARK READ-SCREEN
-    %BUF @ %MLEN @ BL FILL
-    SLINE-BUF 79 -TRAILING %MLEN @ MIN %BUF @ SWAP CMOVE
-    .LIN  MEOL LITTLE-CURSOR ;
-Screen 27 not modified
-\  F-WORD B-WORD                               13:42JWB03/03/87
-  : F-WORD  ( --  -- )
-         BEGIN   POS@ C@ BL <>
-         WHILE   1 +POS   REPEAT
-         BEGIN   POS@ C@ BL =
-         WHILE   1 +POS   REPEAT  .POS ;
-
-  : B-WORD ( --  -- )
-         BEGIN  POS@ C@ BL <>
-         WHILE  -1 +POS  REPEAT
-         BEGIN  POS@ C@ BL =
-         WHILE  -1 +POS  REPEAT
-         BEGIN  POS@ C@ BL <>
-         WHILE  -1 +POS  REPEAT
-         1 +.POS ;
-
-Screen 28 not modified
-\  D-WORD  F-CHAR                              14:32JWB03/03/87
-  : D-WORD ( --  -- )
-         POS@ C@ BL <> IF
-         BEGIN  POS@ C@ BL <>
-         WHILE  -1 +POS  REPEAT
-         1 +POS .POS
-         BEGIN  POS@ C@ BL <>
-         WHILE  DCHAR
-         REPEAT DCHAR  THEN ;
-
-: PCKEY ( --   n flag )
-         {KEY}
-             ?DUP IF TRUE ELSE {KEY} FALSE THEN ;
-
-
-
-Screen 29 not modified
-\                                              14:33JWB03/03/87
-\ Clear backup buffer.
-: CLR.BK.BUF ( --  -- )
-   RLFLAG  OFF
-   BK.BUF BK.SIZE BL FILL
-   BK.PTR OFF PR.PTR OFF ;
-
-  : F-CHAR  ( --   -- )
-         PCKEY
-         IF  %MLEN @ %POS @ 1+
-             DO I %BUF @ + C@ OVER =
-                IF  I !POS LEAVE THEN
-             LOOP  .POS
-         THEN DROP ;
-
-
-Screen 30 not modified
-\  RET  PCKEY                                  14:24JWB03/03/87
-: DBOL  ( --  -- )
-     SLINE-BUF 80 BL FILL
-     POS@ SLINE-BUF #R DUP >R CMOVE
-     %BUF @ %MLEN @ BL FILL
-     SLINE-BUF %BUF @ R> CMOVE .LIN  HOM ;
-
-
-: RET   ( --   -- )     \ Finished, move to eol, set %DONE ON
-        SLINE @  -MARK  MEOL  %DONE ON OVER-STRIKE  ;
-
-
-
-
-
-
-Screen 31 not modified
-\ CTRL.KEY                                     14:17JWB03/03/87
-: CTRL.KEY
-         CASE
-CONTROL M OF RET                     ENDOF
-CONTROL H OF RUB                     ENDOF
-CONTROL L OF CLR                     ENDOF
-CONTROL Q OF F-CHAR                  ENDOF
-CONTROL S OF L-ARROW                 ENDOF
-CONTROL T OF D-WORD                  ENDOF
-CONTROL D OF R-ARROW                 ENDOF
-CONTROL I OF 5 +.POS OVER-STRIKE     ENDOF
-CONTROL U OF DEALL                   ENDOF
-        27 OF DEALL                   ENDOF
-CONTROL X OF DEOL                    ENDOF
-         ( OTHERS ) ( BEEP )
-         ENDCASE ;
-Screen 32 not modified
-\  FUNC.KEY                                    09:51JWB02/07/86
-
-: FUNC.KEY
-         CASE
-   31 OF  -TRANS         ENDOF       32 OF  +TRANS         ENDOF
-   75 OF  L-ARROW        ENDOF       77 OF  R-ARROW        ENDOF
-   71 OF  HOM            ENDOF       79 OF  MEOL           ENDOF
-   81 OF  +RECALL-LINE   ENDOF       73 OF  -RECALL-LINE   ENDOF
-   83 OF  DCHAR          ENDOF       82 OF  INSS           ENDOF
-   80 OF  +RECALL-SLINE  ENDOF       72 OF  -RECALL-SLINE  ENDOF
-  117 OF  DEOL           ENDOF      119 OF  DBOL           ENDOF
-  115 OF  B-WORD         ENDOF      116 OF  F-WORD         ENDOF
-  132 OF  CLR.BK.BUF     ENDOF
-         ( OTHERS ) ( BEEP )
-         ENDCASE ;
-
-Screen 33 not modified
-\ (LEDIT)                                      09:51JWB02/07/86
-\ Edit line of length len at address adr. If flag is true move
-\ to beginning of line, if false move to end of line.
-: (LEDIT)  ( adr len flag   -- )
-         -ROT 79 MIN 2DUP %MLEN ! %BUF !
-         %POS OFF  %DONE OFF   7 ATRIB !
-         CUR@ 256 /MOD  %ROW !  %OFF !
-         -TRAILING CTYPE IF HOM ELSE MEOL THEN
-         BEGIN PCKEY 2DUP FLIP + LKEY !
-         IF   DUP  31 < IF  CTRL.KEY
-                        ELSE %MOD @ IF ICHAR ELSE ECHO THEN THEN
-         ELSE FUNC.KEY  THEN
-         %DONE @ UNTIL SAVE-LINE  ;
-
-
-
-Screen 34 not modified
-\  LEDIT  <LEDIT  <EXPECT>                     09:51JWB02/07/86
-ALSO FORTH DEFINITIONS
-
-\ Edit line of length n at adr. Begin by displaying string at
-\ adr and then sit cursor at end of string.
-: LEDIT ( adr n   -- )
-         FALSE (LEDIT) ;
-\ As above, but put cursor at beginning of line.
-: <LEDIT ( adr n   -- )
-         TRUE (LEDIT) ;
-
-: <EXPECT> ( adr n   -- )
-         2DUP BL FILL 2DUP <LEDIT -TRAILING
-         PRINTING @ IF 2DUP HOM TYPE THEN
-         DUP SPAN !  #OUT ! DROP SPACE ;
-
-Screen 35 not modified
-\ NEW-EXP  OLD-EXP                             09:51JWB02/07/86
-: NEW-EXP  ['] <EXPECT> ['] EXPECT 2+ !
-            ['] EXIT     ['] EXPECT 4 + ! ;
-
-: OLD-EXP  ['] DUP      ['] EXPECT 2+ !
-            ['] SPAN     ['] EXPECT 4 + ! ;
-
-ONLY FORTH ALSO
-
-
-
-
-
-
-
-
-</code>