EDYTOR-FORTH.4TH

( RAGSDALE ASM + EDW + EDYTOR FORTHA )

( RAGSDALE ASSEMBLER )
VOCABULARY ASSEMBLER IMMEDIATE ASSEMBLER DEFINITIONS BASE @ HEX

0 VARIABLE INDEX -2 ALLOT 0909 , 1505 , 0115 , 8011 , 8009 ,
1D0D , 8019 , 8080 , 0080 , 1404 , 8014 , 8080 , 8080 ,
1C0C , 801C , 2C80 ,
2 VARIABLE MODE : .A 0 MODE ! ; : # 1 MODE ! ; : MEM 2 MODE ! ;
: ,X 3 MODE ! ; : ,Y 4 MODE ! ; : X) 5 MODE ! ; : )Y 6 MODE ! ;
: ) F MODE ! ; : BOT ,X 0 ; : SEC ,X 2 ; : RP) ,X 101 ;
: UPMODE IF MODE @ 8 AND 0= IF 8 MODE +! THEN THEN
1 MODE @ F AND -DUP IF 0 DO DUP + LOOP THEN OVER 1+ @ AND 0= ;
: CPU <BUILDS C, DOES> C@ C, MEM ;
00 CPU BRK, 18 CPU CLC, D8 CPU CLD, 58 CPU CLI, B8 CPU CLV,
CA CPU DEX, 88 CPU DEY, E8 CPU INX, C8 CPU INY, EA CPU NOP,
48 CPU PHA, 08 CPU PHP, 68 CPU PLA, 28 CPU PLP, 40 CPU RTI,
60 CPU RTS, 38 CPU SEC, F8 CPU SED, 78 CPU SEI, AA CPU TAX, 
A8 CPU TAY, BA CPU TSX, 8A CPU TXA, 9A CPU TXS, 98 CPU TYA,
: MCP <BUILDS C, , DOES> DUP 1+ @ 80 AND IF 10 MODE +! THEN
OVER FF00 AND UPMODE UPMODE IF MEM CR LATEST ID. 3 ERROR THEN
C@ MODE C@ INDEX + C@ + C, MODE C@ 7 AND IF MODE C@ F AND 7 <
IF C, ELSE , THEN THEN MEM ;
1C6E 60 MCP ADC, 1C6E 20 MCP AND, 1C6E C0 MCP CMP,
1C6E 40 MCP EOR, 1C6E A0 MCP LDA, 1C6E 00 MCP ORA,
1C6E E0 MCP SBC, 1C6C 80 MCP STA, 0D0D 01 MCP ASL,
0C0C C1 MCP DEC, 0C0C E1 MCP INC, 0D0D 41 MCP LSR,
0D0D 21 MCP ROL, 0D0D 61 MCP ROR, 0414 81 MCP STX,
0486 E0 MCP CPX, 0486 C0 MCP CPY, 1496 A2 MCP LDX,
0C8E A0 MCP LDY, 048C 80 MCP STY, 0480 14 MCP JSR,
8480 40 MCP JMP, 0484 20 MCP BIT,
: BEGIN, HERE 1 ; IMMEDIATE
: UNTIL, ?EXEC >R 1 ?PAIRS R> C, HERE 1+ - C, ; IMMEDIATE 
( RAGSDALE ASSEMBLER )
: IF, C, HERE 0 C, 2 ; IMMEDIATE
: THEN, ?EXEC 2 ?PAIRS HERE OVER C@ IF SWAP ! ELSE OVER 1+
- SWAP C! THEN ;  IMMEDIATE
: ELSE, 2 ?PAIRS HERE 1+ 1 JMP, SWAP HERE OVER 1+ - SWAP C!
2 ;  IMMEDIATE
: NOT 20 + ;
90 CONSTANT CS D0 CONSTANT 0= 10 CONSTANT 0< 90 CONSTANT >=

: END-CODE CURRENT @ CONTEXT ! ?EXEC ?CSP SMUDGE ;  IMMEDIATE
FORTH DEFINITIONS DECIMAL

( RP added )
: C; CURRENT @ CONTEXT ! ?EXEC ?CSP SMUDGE ; IMMEDIATE

: CODE ?EXEC CREATE [COMPILE] ASSEMBLER ASSEMBLER MEM !CSP ;
IMMEDIATE
' ASSEMBLER CFA ' ;CODE 8 + ! LATEST 12 +ORIGIN !
HERE 28 +ORIGIN ! HERE 30 +ORIGIN ! HERE FENCE !
' ASSEMBLER 6 + 32 +ORIGIN !     BASE ! FORTH 

( RP added )
: MAC  -FIND 0= 0 ?ERROR
DROP 32 C, , ; IMMEDIATE
( END )


: --> ; ( if pasted into Altirra and not loaded )


( Public Domain 4th Tools v0.1 )
( For Extended fig-FORTH Rev.2 )
( Collected by BartGo 20231006 )
( 0x-0x: ASM   by WR,RP        )
( 35-35: This info screen      )
( 36-40: EDW   by RP           )
( 0x-0x: ED    by RP           )
( 41-51: EDIT  by M. Dougherty )
( 0x-0x: SERT  by ...          )
( 0x-0x: TRADE by ...          )
( 0x-0x: -                     )
( 0x-0x: -                     )
( See also:                    )
( FORTHCON.BAS by HS           )
( FORTHDOS.BAS by WV           )
;S
( - EDytor Wprowadzania: 1/5 - )
(    autor: Roland Pantola     )
(   [c]1992 Tajemnice Atari    )

( "FORGET TASK" to remove EDW! )
: TASK ;
: <=< OVER > >R < R> * ;
37000 CONSTANT AD0
0 VARIABLE AB  0 VARIABLE *K
0 VARIABLE LIN 0 VARIABLE EN
: AF AD0 AB @ + ;
: B32 32 BASE ! ;
: NK IF 0 0 ELSE B32 AF NUMBER
  DECIMAL 1024 U/ THEN ;
: N1 0 AF COUNT OVER + SWAP ;
( ( --> ) )
( - EDytor Wprowadzania: 2/5 - )  
: NU N1 DO
  I C@ 47 OVER 58 <=< 64 ROT
  87 <=< + 0= + LOOP NK ;
: K0 1 *K +! C@ *K @ * DUP
  EN +! + 1024 MOD ;
: K1 DO
  I K0 I C@ 0= IF I 38
  BLANKS LEAVE THEN LOOP ;
: KP 0 *K ! 4 AF C! 32 AF
  5 + C! NU 0 EN ! ;
: KOD= KP >R >R 0 AF 38 + AF 6
  + K1 R> = R> LIN @ = SWAP
  OVER * ; 
: .R2 0 <# # # #> TYPE SPACE ;
( --> ) 
( - EDytor Wprowadzania: 3/5 - )
: ?L LIN @ B32 .R2 DECIMAL ;
: WP 125 EMIT 1 LIN +!
  ." Do wprowadzenia linia "
  ?L CR CR ;
: ?DOB DROP AF 6 + AF 32 CMOVE
  32 AB +! WP 1 ;
: ?Z CR CR AF 1+ 37 TYPE 155
  EMIT 28 EMIT 0 ;
: LL
  ." Teraz potrzebna linia: "
  ?L ;
: ?ZLE 125 EMIT 0= IF LL ELSE
  ." Popraw: " THEN ?Z ;

( --> )
( - EDytor Wprowadzania: 4/5 - )
: KO KOD= IF ?DOB ELSE ?ZLE
  THEN EN @ 1442 = * ;
: GO 125 EMIT CR ." Gotowe!"
  CR ;
: E1 1 82 C! 0 AB ! 0 LIN !
  WP ;
: BBL AF 1024 AB @ OVER MOD
  - DUP AB +! BLANKS ;






( --> )
( - EDytor Wprowadzania: 5/5 - )

( EDW: --                      )
: EDW E1 BEGIN AF 39 ERASE
  AF 1+ 37 EXPECT KO UNTIL BBL
  GO ;

( EDW-SAVE: n --               )
: BSAV OVER + SWAP DO DUP I 0
  R/W B/BUF + LOOP DROP ;
: EDW-SAVE AD0 SWAP B/SCR *
  AB @ B/BUF / BSAV ;

;S

( /END )

( EDYTOR-FORTH /STARTS @ )
( autor: Roland Pantola )
( [c] 1992 T.A. ) : TASK ;
FORTH FORTH DEFINITIONS
0 VARIABLE #GGE
: GGE #GGE @ ; 129 #GGE !
: <=< OVER > >R < R> * ; ASSEMBLER
CODE INSTR 3 ,X LDA, XSAVE
 3 + STA, 2 ,X LDY,
0= IF, XSAVE 3 + DEC,
THEN, DEY, XSAVE 2+ STY,
0 ,X LDY, 4 ,X LDA,
BEGIN, XSAVE 2+ )Y CMP,
0= NOT IF, DEY, THEN,
0= UNTIL, 4 ,X STY,
 POPTWO JMP, END-CODE -->
( A ADR DLU --- NR )
: SELECT <BUILDS SMUDGE ] DOES>
SWAP 2 * + @ EXECUTE ;
: % COMPILE CLIT BL WORD HERE
NUMBER DROP -1 OVER 256 <=< 0=
IF CR ." Error: % " DUP .
 ENDIF C, ; IMMEDIATE
0 VARIABLE #C 2 ALLOT
64 #C C!
0 #C 1+ C!
32 #C 2+ C!
96 #C 3 + C!



-->

ASSEMBLER
CODE CMOVE> 2 ,X LDA, XSAVE 2+
STA, 4 ,X LDA, XSAVE 4 + STA,
1 ,X LDA, CLC, 5 ,X ADC,
XSAVE 5 + STA, 1 ,X LDA,
CLC, 3 ,X ADC, XSAVE 3 + STA,
BEGIN, 0 ,X LDY,
BEGIN, DEY, XSAVE 4 + )Y LDA,
XSAVE 2+ )Y STA, 0 # CPY, 0=
UNTIL, XSAVE 5 + DEC, XSAVE
3 + DEC, 0 ,X LDA, 0= IF,
1 ,X LDA, 0= NOT
IF, 1 ,X DEC, THEN, THEN,
0 # LDA, 0 ,X STA,
 1 ,X LDA, 0= UNTIL, -->
INX, INX, XSAVE STX, POPTWO
JMP, END-CODE ASSEMBLER

CODE ASC-PEEK XSAVE STX,
2 ,X LDA, XSAVE 2+ STA,
3 ,X LDA, XSAVE 3 + STA,
0 ,X LDY,
BEGIN, DEY, XSAVE 2+ )Y LDA,
96 # AND, .A LSR, .A LSR,
.A LSR, .A LSR, .A LSR, TAX,
XSAVE 2+ )Y LDA,
255 96 - # AND, #C ,X ORA,
XSAVE 2+ )Y STA, 0 # CPY,
0= UNTIL, XSAVE LDX,
POPTWO JMP, END-CODE
-->


: PEEK-ASC OVER OVER 2 0
DO ASC-PEEK LOOP ;
( ADDR DLU --- )
4 VARIABLE XPOS 4 VARIABLE YPOS
: XPOS@ XPOS @ ;
: YPOS@ YPOS @ ;
: POSE YPOS ! XPOS ! ;
48 CONSTANT ZERO
: X! % 85 ! ; : Y! % 84 C! ;
: X@ % 85 @ ; : Y@ % 84 C@ ;
: POS Y! X! ;
: 0.R ' ZERO CFA ' SPACE ! .R
' BL CFA ' SPACE ! ;
: BEEP 253 EMIT ; --> 

VOCABULARY EDITOR IMMEDIATE
EDITOR DEFINITIONS
: #DLE [ 112 C, 66 C, 48032 ,
2 C, 2 C, 2 C, 2 C, 2 C, 2 C,
 2 C, 2 C, 2 C, 2 C, 2 C, 2 C, 2
 C, 2 C, 2 C, 2 C, 2 C, 2 C, 2
 C, 2 C, 2 C, 2 C, 2 C, 2 C, 2
 C, 2 C, 2 C, 65 C, 47998 , ] ;
: #SCR? 0 % 10 POS ." SCR"
  0 % 12 POS SCR @ 3 0.R ;
: ADBUFF HERE 260 + ;
: LBUFF ADBUFF 2 - ;
: CZYBUFF ADBUFF % 4 -
@ 31886 = ;
-->


: #BUFF? CZYBUFF IF LBUFF
@ ELSE 0 ADBUFF 2 - ! 31886
ADBUFF 4 - ! 0 ENDIF 0 % 16 POS
." BUF" 0 % 18 POS % 3 0.R ;
: #DISPE ' #DLE 47998 % 34
CMOVE 47998 560 ! 48032 % 88 !
; : #RAMKA % 125 EMIT % 88 @
% 28 0 DO DUP I % 40 * + % 3 +
% 124 SWAP OVER OVER % 33 + ! !
LOOP DROP #SCR? #BUFF? ;
0 VARIABLE #LINIA0
: #W# SCR @ B/SCR * DUP B/SCR +
SWAP ; : #WEJ #W# DO I
 BLOCK % 128 ASC-PEEK LOOP ; -->
: #WYJ #W# DO I BLOCK % 128
PEEK-ASC LOOP ;
48036 CONSTANT ADE: : ADLINE
% 40 * ADE: + ;
: #KP SWAP OVER OVER 1 - C!
OVER OVER 32 + C! DROP DROP ;
: KK? ADLINE % 84 #KP ;
: PP? ADLINE % 124 #KP ;
: #LIN# DUP % 4 /MOD SCR @
B/SCR * + BLOCK SWAP % 32 * +
SWAP ADLINE #LINIA0 @ % 40 * -
; : LIN-E: #LIN# % 32 CMOVE ;
: EK-E: #LINIA0 @ DUP % 28 +
SWAP DO I LIN-E: LOOP ;
: LIN-BUF #LIN#  SWAP % 32
 CMOVE ; -->


: EK-BUF #LINIA0 @ DUP % 28 +
SWAP DO I LIN-BUF LOOP ;
: E:V ADLINE DUP % 40 - % 26
ADLINE DO I DUP % 40 + % 32
CMOVE -40 +LOOP % 32 ERASE ;

: E:^ ADLINE % 40 +
% 28 ADLINE
SWAP DO I DUP % 40 - % 32
CMOVE % 40 +LOOP % 27 ADLINE
% 32 ERASE ;

: LINB #LINIA0 @ + ;
: E: ADE: % 4 - -->
XPOS@ + YPOS@
% 40 * + ; : E:@ E: C@ ;
: E:! E: C! ;

: #KUR E:@ DUP % 127 >
IF % 128
- ELSE % 128 +
ENDIF E:! ;

: &PP
POSE #LINIA0 @ DUP 0=
IF 0 KK? ELSE 0 PP? ENDIF
% 4 = IF % 27 KK? ELSE % 27
PP? ENDIF ;

-->


: #POS SWAP DUP % 4 < IF DROP
% 35 SWAP % 1 - SWAP ENDIF
DUP % 35 > IF DROP % 4 SWAP
1+ SWAP ENDIF SWAP
DUP 0 < IF #LINIA0 @ IF % 27
LINB LIN-BUF
 -1 #LINIA0 +! 0 E:V 0 LINB
LIN-E: DROP 0
ELSE DROP % 27 ENDIF ENDIF
DUP % 27 > IF #LINIA0 @ 4 =
IF DROP 0 ELSE
0 LINB LIN-BUF 1 #LINIA0 +! 0
E:^ % 27 LINB LIN-E:
DROP % 27 ENDIF ENDIF &PP ; -->
: #PISZ DUP SP@ 1 ASC-PEEK #KUR
 E:! XPOS@ 1+ YPOS@ #POS #KUR ;
: #KXY@ #KUR XPOS@ YPOS@ ;
: #PK #POS #KUR ;
: ?< #KXY@ SWAP 1 - SWAP #PK ;
: ?> #KXY@ SWAP 1+ SWAP #PK ;
: ?^ #KXY@ 1 - #PK ;
: ?V #KXY@ 1+ #PK ;
: #RET #KXY@ 1+ SWAP DROP % 4
SWAP #PK 0 LBUFF ! #BUFF? ;
: #COF #KXY@ SWAP 1 - SWAP #POS
0 E:! #KUR ; : BFREE 430 LBUFF
@ % 32 * + 471 @ HERE - U< ;
: >BUFF YPOS@ ADLINE ADBUFF
LBUFF @ % 32 * + % 32 CMOVE
 1 LBUFF +! #BUFF? ; -->


0 VARIABLE #CM 67 ALLOT
: #BU# % 28 #LIN# DROP DUP
% 32 + % 96 ;
: #EB# % 27 ADLINE % 28 LINB
#LIN# DROP ;
: BUFV #BU#  CMOVE> ;

: BUF^ #BU# OVER >R >R SWAP R>
CMOVE R> % 64 + % 32 ERASE ;
: XSP DO I C@ 0= 0= IF DROP I
LEAVE ENDIF LOOP ;

: OSTLIN #LINIA0 @ % 4 = IF 0
 % 27 ADLINE DUP % 32 + -->
SWAP XSP ELSE 0 % 31 #LIN#
DROP DUP % 32 + SWAP XSP
ENDIF 0= ;

: #^^ BFREE IF #KUR >BUFF
YPOS@ E:^ #LINIA0 @
% 4 < IF #EB# SWAP % 32
CMOVE ENDIF BUF^ #KUR
ELSE BEEP BEEP ENDIF ;

: #VV OSTLIN IF
#KUR BUFV #LINIA0 @ % 4 <
IF #EB# % 32 CMOVE ENDIF
YPOS@ E:V #KUR ELSE BEEP
ENDIF ;
-->


: #<BF OSTLIN IF LBUFF @ IF #VV
-1 LBUFF +! ADBUFF LBUFF @
32 * + YPOS@ ADLINE % 32
CMOVE #BUFF? #KUR ENDIF ELSE
BEEP ENDIF ;
: X#CM #CM XPOS@ + % 4 - ;
: XSPAC #CM % 63 + DUP X#CM
XSP #CM % 64 + DUP ROT
DO I C@ 0= I 1+ C@
0= * IF DROP I LEAVE
ENDIF LOOP X#CM - ;
: <#CM> YPOS@ #LINIA0 @ XPOS@
YPOS@ 1+ #POS #LINIA0 @ = 0=
- YPOS ! -->
YPOS@ ADLINE #CM OVER OVER
YPOS@ % 27 < IF SWAP % 40
+ SWAP % 32 + ENDIF ;
: 32CM % 32 CMOVE ;
: >#CM  #KUR <#CM> #CM 66
ERASE 32CM 32CM ;
: <#CM <#CM> SWAP 32CM SWAP
32CM #KUR ;
: #>> >#CM XSPAC #CM % 63 +
C@ 0= OVER X#CM + #CM - % 63
< + IF X#CM DUP 1+ ROT
CMOVE> 0 X#CM C! ELSE BEEP
DROP ENDIF <#CM ;
: #<< >#CM X#CM 1+ DUP 1 -
XSPAC CMOVE <#CM ;
-->
( --- )

: #DUP DUP DUP % 127 >
IF % 128 - ENDIF ;
: ESC DROP KEY #DUP BL = IF
DROP 300 ELSE #PISZ ENDIF ;
: #KLA0 [ 27 C, 28 C, 29 C, 30
C, 31 C, 155 C, 126 C, 254 C,
255 C, 156 C, 157 C, 127 C,
] ;
: #NR-KLAW ' #KLA0 % 12 INSTR ;
SELECT #WYB0 #PISZ ESC ?^ ?V ?<
 ?> #RET #COF #<< #>> #^^ #VV
#<BF ;

-->
FORTH DEFINITIONS
: (E) EDITOR  #WEJ
1 752 C! #DISPE #RAMKA
XPOS@ YPOS@ #POS
EK-E: #KUR
BEGIN
KEY DUP #NR-KLAW #WYB0
300 = UNTIL
#KUR EK-BUF #WYJ FORTH ;
: EXFO % 125 EMIT % 80 % 88 +!
." FORTH" CR 0 752 C! ;
: CLEAR % 16 0 DO I SCR @
(LINE) DROP C/L BLANKS UPDATE
LOOP ;

-->
( EDYTOR-FORTH /ENDS     )
( ED-DYSK )
: MARK SCR @ % 8 * % 8 0 DO I
OVER + BLOCK DROP UPDATE
LOOP DROP ;
: E. (E) EXFO ;
: L. SCR ! E. ;
: F. MARK FLUSH ;
: INDE EMPTY-BUFFERS
GGE SWAP GGE 1 - MIN
DO I 8 * BLOCK 32 -TRAILING
OVER @ DUP 8224 = 0= * IF CR
I . SPACE TYPE ELSE 2DROP ENDIF
?TERMINAL IF LEAVE ENDIF
LOOP EMPTY-BUFFERS ;
: IND 1 INDE ; ;S ( /END )

***
ponizej wersja z kodami, do detekcji bledow; potem, naprawic powyzej i ponizej, obie wersje zachowac
wszystkie wersje z kodami sprawdzic i zachowac

01N7 ( EDYTOR-FORTH )
0200
03CO ( autor: Roland Pantola )
04Q9 ( [c] 1992 T.A. )
05C7 0 VARIABLE #GGE
06GS : GGE #GGE @ ;
07KS 129 #GGE !
08VP CODE INSTR
093P 3 ,X LDA, XSAVE 3 + STA,
0ANE 2 ,X LDY,
0BJG 0= IF, XSAVE 3 + DEC,
0CBU THEN, DEY, XSAVE 2+ STY,
0DFE 0 ,X LDY, 4 ,X LDA,
0EVJ BEGIN, XSAVE 2+ )Y CMP,
0F0L 0= NOT IF, DEY, THEN,
0GFP 0= UNTIL, 4 ,X STY,
0HE5 POPTWO JMP, C;
0I1H ( A ADR DLU --- NR )
0JUD : SELECT <BUILDS SMUDGE ] DOES>
0KMB SWAP 2 * + @ EXECUTE ;
0LAM : % COMPILE CLIT BL WORD HERE
0MFR NUMBER DROP -1 OVER 256 <=< 0=
0NSD IF CR ." Error: % " DUP .
0OSI ENDIF C, ;
0P5S IMMEDIATE
0Q3H 0 VARIABLE #C 2 ALLOT
0RJM 64 #C C!
0SBT 0 #C 1+ C!
0TRH 32 #C 2+ C!
0U9L 96 #C 3 + C!
0V00
10A1 -->
1100
1200
13VQ CODE CMOVE> 2 ,X LDA, XSAVE 2+
14M4 STA, 4 ,X LDA, XSAVE 4 + STA,
153F 1 ,X LDA, CLC, 5 ,X ADC,
166P XSAVE 5 + STA, 1 ,X LDA,
17HF CLC, 3 ,X ADC, XSAVE 3 + STA,
18QU BEGIN, 0 ,X LDY,
19BA BEGIN, DEY, XSAVE 4 + )Y LDA,
1A91 XSAVE 2+ )Y STA, 0 # CPY, 0=
1B2P UNTIL, XSAVE 5 + DEC, XSAVE
1CTC 3 + DEC, 0 ,X LDA, 0= IF,
1D0U 1 ,X LDA, 0= NOT
1EC5 IF, 1 ,X DEC, THEN, THEN,
1FE2 0 # LDA, 0 ,X STA,
1GF6 1 ,X LDA, 0= UNTIL,
1H9K INX, INX, XSAVE STX, POPTWO
1IIJ JMP, C;
1J00
1K0U CODE ASC-PEEK XSAVE STX,
1L68 2 ,X LDA, XSAVE 2+ STA,
1M3P 3 ,X LDA, XSAVE 3 + STA,
1NNC 0 ,X LDY,
1O6Q BEGIN, DEY, XSAVE 2+ )Y LDA,
1PEJ 96 # AND, .A LSR, .A LSR,
1Q03 .A LSR, .A LSR, .A LSR, TAX,
1RGO XSAVE 2+ )Y LDA,
1SFR 255 96 - # AND, #C ,X ORA,
1TH5 XSAVE 2+ )Y STA, 0 # CPY,
1UKB 0= UNTIL, XSAVE LDX,
1VE5 POPTWO JMP, C;
20A1 -->
2100
2200
23S9 : PEEK-ASC OVER OVER 2 0
24OV DO ASC-PEEK LOOP ;
25P4 ( ADDR DLU --- )
26EO 4 VARIABLE XPOS 4 VARIABLE YPOS
279G : XPOS@ XPOS @ ;
289S : YPOS@ YPOS @ ;
29EI : POSE YPOS ! XPOS ! ;
2AMR 48 CONSTANT ZERO
2BL5 : X! % 85 ! ; : Y! % 84 C! ;
2CEA : X@ % 85 @ ; : Y@ % 84 C@ ;
2DNM : POS Y! X! ;
2EQ0 : 0.R ' ZERO CFA ' SPACE ! .R
2FTK ' BL CFA ' SPACE ! ;
2GPI : BEEP 253 EMIT ;
2H00
2I77 VOCABULARY EDITOR IMMEDIATE
2JFB EDITOR DEFINITIONS
2K86 : #DLE [ 112 C, 66 C, 48032 ,
2LBD 2 C, 2 C, 2 C, 2 C, 2 C, 2 C,
2MPR 2 C, 2 C, 2 C, 2 C, 2 C, 2 C, 2
2N3T C, 2 C, 2 C, 2 C, 2 C, 2 C, 2
2O3T C, 2 C, 2 C, 2 C, 2 C, 2 C, 2
2P9S C, 2 C, 2 C, 65 C, 47998 , ] ;
2QFH : #SCR? 0 % 10 POS ." SCR"
2R9S   0 % 12 POS SCR @ 3 0.R ;
2SVL : ADBUFF HERE 260 + ;
2T88 : LBUFF ADBUFF 2 - ;
2UIA : CZYBUFF ADBUFF % 4 -
2V5D @ 31886 = ;
30A1 -->
3100
3200
33A1 : #BUFF? CZYBUFF IF LBUFF
34NE @ ELSE 0 ADBUFF 2 - ! 31886
351V ADBUFF 4 - ! 0 ENDIF 0 % 16 POS
36NA ." BUF" 0 % 18 POS % 3 0.R ;
377A : #DISPE ' #DLE 47998 % 34
38EN CMOVE 47998 560 ! 48032 % 88 !
39PC ; : #RAMKA % 125 EMIT % 88 @
3ASM % 28 0 DO DUP I % 40 * + % 3 +
3BFO % 124 SWAP OVER OVER % 33 + ! !
3CQS LOOP DROP #SCR? #BUFF? ;
3DLC 0 VARIABLE #LINIA0
3EAK : #W# SCR @ B/SCR * DUP B/SCR +
3FMT SWAP ; : #WEJ #W# DO I
3GQD BLOCK % 128 ASC-PEEK LOOP ;
3H49 : #WYJ #W# DO I BLOCK % 128
3IGF PEEK-ASC LOOP ;
3JDU 48036 CONSTANT ADE: : ADLINE
3KLT % 40 * ADE: + ;
3L7K : #KP SWAP OVER OVER 1 - C!
3MFA OVER OVER 32 + C! DROP DROP ;
3NIH : KK? ADLINE % 84 #KP ;
3OM3 : PP? ADLINE % 124 #KP ;
3PR9 : #LIN# DUP % 4 /MOD SCR @
3QRP B/SCR * + BLOCK SWAP % 32 * +
3RPG SWAP ADLINE #LINIA0 @ % 40 * -
3SUC ; : LIN-E: #LIN# % 32 CMOVE ;
3TOK : EK-E: #LINIA0 @ DUP % 28 +
3UOR SWAP DO I LIN-E: LOOP ;
3VSA : LIN-BUF #LIN#  SWAP % 32
40EP CMOVE ; -->
4100
4200
43II : EK-BUF #LINIA0 @ DUP % 28 +
44NP SWAP DO I LIN-BUF LOOP ;
45N5 : E:V ADLINE DUP % 40 - % 26
46NO ADLINE DO I DUP % 40 + % 32
47MF CMOVE -40 +LOOP % 32 ERASE ;
4800
49HH : E:^ ADLINE % 40 +
4A6H % 28 ADLINE
4B19 SWAP DO I DUP % 40 - % 32
4C9T CMOVE % 40 +LOOP % 27 ADLINE
4DGB % 32 ERASE ;
4E00
4FU7 : LINB #LINIA0 @ + ;
4GE3 : E: ADE: % 4 -
4H18 XPOS@ + YPOS@
4IOM % 40 * + ; : E:@ E: C@ ;
4J7H : E:! E: C! ;
4K00
4L1F : #KUR E:@ DUP % 127 >
4MLD IF % 128
4NRR - ELSE % 128 +
4OCK ENDIF E:! ;
4P00
4QTS : &PP
4R8I POSE #LINIA0 @ DUP 0=
4STB IF 0 KK? ELSE 0 PP? ENDIF
4TGV % 4 = IF % 27 KK? ELSE % 27
4UTT PP? ENDIF ;
4V00
50A1 -->
5100
5200
53L9 : #POS SWAP DUP % 4 < IF DROP
54TL % 35 SWAP % 1 - SWAP ENDIF
55OI DUP % 35 > IF DROP % 4 SWAP
56FP 1+ SWAP ENDIF SWAP
57R7 DUP 0 < IF #LINIA0 @ IF % 27
585V LINB LIN-BUF
598Q -1 #LINIA0 +! 0 E:V 0 LINB
5AC9 LIN-E: DROP 0
5BE1 ELSE DROP % 27 ENDIF ENDIF
5CJ7 DUP % 27 > IF #LINIA0 @ 4 =
5DIT IF DROP 0 ELSE
5EQT 0 LINB LIN-BUF 1 #LINIA0 +! 0
5FF2 E:^ % 27 LINB LIN-E:
5GUV DROP % 27 ENDIF ENDIF &PP ;
5HTS : #PISZ DUP SP@ 1 ASC-PEEK #KUR
5I12 E:! XPOS@ 1+ YPOS@ #POS #KUR ;
5JSP : #KXY@ #KUR XPOS@ YPOS@ ;
5K06 : #PK #POS #KUR ;
5LM8 : ?< #KXY@ SWAP 1 - SWAP #PK ;
5MDB : ?> #KXY@ SWAP 1+ SWAP #PK ;
5NVJ : ?^ #KXY@ 1 - #PK ;
5O5J : ?V #KXY@ 1+ #PK ;
5PRQ : #RET #KXY@ 1+ SWAP DROP % 4
5Q7Q   SWAP #PK 0 LBUFF ! #BUFF? ;
5R8S : #COF #KXY@ SWAP 1 - SWAP #POS
5S2G 0 E:! #KUR ; : BFREE 430 LBUFF
5TH5 @ % 32 * + 471 @ HERE - U< ;
5UTL : >BUFF YPOS@ ADLINE ADBUFF
5VHU LBUFF @ % 32 * + % 32 CMOVE
60AG 1 LBUFF +! #BUFF? ; -->
6100
6200
630O 0 VARIABLE #CM 67 ALLOT
64SF : #BU# % 28 #LIN# DROP DUP
65SR % 32 + % 96 ;
66CT : #EB# % 27 ADLINE % 28 LINB
67LK #LIN# DROP ;
68EH : BUFV #BU#  CMOVE> ;
6900
6A0O : BUF^ #BU# OVER >R >R SWAP R>
6B17 CMOVE R> % 64 + % 32 ERASE ;
6CSL : XSP DO I C@ 0= 0= IF DROP I
6DPI LEAVE ENDIF LOOP ;
6E00
6F7F : OSTLIN #LINIA0 @ % 4 = IF 0
6GUF % 27 ADLINE DUP % 32 +
6HIG SWAP XSP ELSE 0 % 31 #LIN#
6I8U DROP DUP % 32 + SWAP XSP
6JSL ENDIF 0= ;
6K00
6LF9 : #^^ BFREE IF #KUR >BUFF
6M84 YPOS@ E:^ #LINIA0 @
6N5I % 4 < IF #EB# SWAP % 32
6O6D CMOVE ENDIF BUF^ #KUR
6PEV ELSE BEEP BEEP ENDIF ;
6Q00
6RUP : #VV OSTLIN IF
6SQN #KUR BUFV #LINIA0 @ % 4 <
6T0V IF #EB# % 32 CMOVE ENDIF
6U5P YPOS@ E:V #KUR ELSE BEEP
6VKC ENDIF ;
70A1 -->
7100
7200
736U : #<BF OSTLIN IF LBUFF @ IF #VV
7441 -1 LBUFF +! ADBUFF LBUFF @
75IC 32 * + YPOS@ ADLINE % 32
76VT CMOVE #BUFF? #KUR ENDIF ELSE
77MC BEEP ENDIF ;
787N : X#CM #CM XPOS@ + % 4 - ;
79S3 : XSPAC #CM % 63 + DUP X#CM
7ANJ XSP #CM % 64 + DUP ROT
7BFS DO I C@ 0= I 1+ C@
7C6Q 0= * IF DROP I LEAVE
7DJK ENDIF LOOP X#CM - ;
7EK5 : <#CM> YPOS@ #LINIA0 @ XPOS@
7FRS YPOS@ 1+ #POS #LINIA0 @ = 0=
7G0T - YPOS !
7H54 YPOS@ ADLINE #CM OVER OVER
7IVN YPOS@ % 27 < IF SWAP % 40
7JDQ + SWAP % 32 + ENDIF ;
7KKO : 32CM % 32 CMOVE ;
7LBI : >#CM  #KUR <#CM> #CM 66
7ME9 ERASE 32CM 32CM ;
7NK9 : <#CM <#CM> SWAP 32CM SWAP
7OR6 32CM #KUR ;
7P13 : #>> >#CM XSPAC #CM % 63 +
7QNH C@ 0= OVER X#CM + #CM - % 63
7R32 < + IF X#CM DUP 1+ ROT
7SVG CMOVE> 0 X#CM C! ELSE BEEP
7TNH DROP ENDIF <#CM ;
7U2K : #<< >#CM X#CM 1+ DUP 1 -
7VUH XSPAC CMOVE <#CM ;
80A1 -->
8133 ( --- )
8200
83CI : #DUP DUP DUP % 127 >
8466 IF % 128 - ENDIF ;
85DE : ESC DROP KEY #DUP BL = IF
863S DROP 300 ELSE #PISZ ENDIF ;
87NL : #KLA0 [ 27 C, 28 C, 29 C, 30
884V C, 31 C, 155 C, 126 C, 254 C,
89K0 255 C, 156 C, 157 C, 127 C,
8AAE ] ;
8BPO : #NR-KLAW ' #KLA0 % 12 INSTR ;
8C00
8D1I SELECT #WYB0 #PISZ ESC ?^ ?V ?<
8ESJ ?> #RET #COF #<< #>> #^^ #VV
8F3R #<BF ;
8G5I FORTH DEFINITIONS
8HAI : (E) EDITOR  #WEJ
8I54 1 752 C! #DISPE #RAMKA
8J2T XPOS@ YPOS@ #POS
8KEM EK-E: #KUR
8L2B BEGIN
8MSA KEY DUP #NR-KLAW #WYB0
8NB9 300 = UNTIL
8O06 #KUR EK-BUF #WYJ FORTH ;
8P00
8Q96 : EXFO % 125 EMIT % 80 % 88 +!
8RGF ." FORTH" CR 0 752 C! ;
8SLP : CLEAR % 16 0 DO I SCR @
8TMH (LINE) DROP C/L BLANKS UPDATE
8U8P LOOP ;
8VD2 ( END )



01RD ( ED-DYSK )
0200
03RO : MARK SCR @ % 8 * % 8 0 DO I
041E OVER + BLOCK DROP UPDATE
054U LOOP DROP ;
06MM : E. (E) EXFO ;
07SU : L. SCR ! E. ;
08HS : F. MARK FLUSH ;
09RM : INDE EMPTY-BUFFERS
0A2E GGE SWAP GGE 1 - MIN
0BE5 DO I 8 * BLOCK 32 -TRAILING
0CAL OVER @ DUP 8224 = 0= * IF CR
0DA0 I . SPACE TYPE ELSE 2DROP ENDIF
0EIA ?TERMINAL IF LEAVE ENDIF
0F1O LOOP EMPTY-BUFFERS ;
0GSN : IND 1 INDE ;
0HD2 ( END )