[an error occurred while processing this directive] 

: BorEditor ; : ¤ Variable ; 0 ¤ StrHaveChange
0 ¤ TxtHaveChange 0 ¤ CurrStrLn 0 ¤ CurrEdAdr 0 ¤ CurrBufPos
0 ¤ LastEdAdr 0 ¤ HereCore 0 ¤ InsertMode 0 ¤ CurrWinNo
0 ¤ QWindows 0 ¤ MyErrProc 0 ¤ SystemErr 0 ¤ SystemParms
2 allot 1 Variable NullStr t64 ¤ StrBuf t64 allot
&bfc0 Constant EndEdSpace 2 Constant EdId 1 
Bank5 Constant EditorSpace &bfd0 Constant WinEdPar 
&20 Constant MaxFileLen  0 ¤ CurrFileName 10 allot

( Вспмг.функ.--
: RestoreHere HereCore ` -Dup 
   If Here = IfNot HereCore ` Forgt Then [ Then ;
: ShowEdScreen Page ` Mode ` Or Text64 = IfNot 0 Text64 
  Screen Drop Then ; 
: NewWinParms WinEdPar 0 Over ! &10 + EditorSpace Over !
  2+ EditorSpace 1+ Over ! EnterKey EditorSpace !
  2+ 0 Over ! 2+ 0 Swap ! 0 EditorSpace 1- c! ;
: SetUnderWin 
  GetWindow 2Swap Drop PosY ` WinY ` + 2Swap Window ;
: InsStrWin DownKey Out PushState SetUnderWin UpKey Out 
  PopState ;
: DelStrWin SetUnderWin 0 WinDepth @ 1- GotoXY DownKey Out ;
: SaveWindow1 WinEdPar CurrFileName Over &10 Cmove
  &10 + CurrEdAdr ` Over ! 2+ LastEdAdr @ Over !
  2+ TxtHaveChange ` Over ! 2+ InsertMode ` Swap ! ;
: RestoreErr SystemErr ` ErrProc ! ; 

( Ред.функ.-- 
: IsFile 1 outd 0 5 outd ;
: ResetBuf StrBuf 1+ CurrBufPos ! ;
: TxtLen LastEdAdr ` CurrEdAdr ` - ;
: SetCh Dup StrHaveChange ! TxtHaveChange ! ; 
: StrChange True SetCh ; 
: TxtUpDate False SetCh ; 
: WWidth WinWidth ` 1- ; 
: InsertCursor &1 ; : NormalCursor &5f ; 
: SetCursor NormalCursor InsertMode `
   If Drop InsertCursor Then Cursor ! ;
: CheckMaxX PosX @ WWidth < ; 
: ClrStrBuf StrBuf Count Blanks ;
: Set4Edit ClrStrBuf 0 StrHaveChange !
  CurrEdAdr @ StrLn 1- Dup CurrStrLn ! -Dup
   If CurrEdAdr @ StrBuf 1+ Rot Cmove Then ;       
: InsMyString Dup LastEdAdr ` + EndEdSpace u>
  If SaveWindow1 &25 Error Then
  Dup CurrEdAdr ` TxtLen Rot InsString LastEdAdr +! ;
: StoreStr StrHaveChange @
  If StrBuf WWidth -Trail Swap Drop WWidth Min 
   Dup CurrStrLn ` - Dup 8 ! 
   If 8 ` InsMyString Then                   
   StrBuf 1+ CurrEdAdr @ rot Cmove 
   EnterKey CurrEdAdr ` Dup StrLn 1- + c!
  Then ;
: ShowScr&SetAdr StoreStr SaveWindow1 Dup StrLn 
   If PosX @ >r Home Dup CurrEdAdr ! ShowList
    r> 0 GotoXY
   Else Drop
   Then Set4Edit False ;
: ShowScrollStr
  IfNot PushState ToBegStr CurrEdAdr @ ShowString PopState
  Then ;
: InsNullStr InsStrWin CurrEdAdr @ 1 SkipStr Dup >r 
  CurrEdAdr ! 1 InsMyString EnterKey r> c! ;
: DelStr CurrEdAdr ` 1 SkipStr StrLn Dup CurrStrLn ` Or
   If PushState DelStrWin CurrEdAdr ` WinDepth ` SkipStr
   ToBegStr Dup StrLn -Dup
   If 1- Type Else Drop Then  
   CurrStrLn ` Swap
   If 1+ Then Minus InsMyString PopState Else Drop
   Then ;
: InsertMayBe InsertMode `
   If WWidth PosX ` - 1- PushState
    Space CurrBufPos ` Over -Trail Type 
    PopState CurrBufPos ` Dup 1+ Rot <Cmove
   Then ;
: DelSymbol CurrBufPos ` >r WWidth PosX ` - 1- Dup
  StrChange PushState i 1+ i Rot Cmove
  i Over + Blank Swap c! r> Swap -Trail 1+ Type PopState ;

( --
: SaveWindow StoreStr SaveWindow1 ;

( Оконн.функ.--
: OpenWindow Window GetWindow 1 Border . Count 
  WinWidth ` Over - 2/ 0 GotoXY Type 
  GetWindow 1- >r 1- >r 1+ >r 1+ r> r> r> Window ; 
: OpenMessWin QWindows @ 1+ #16 #14 #48 #16 OpenWindow ;
: GetFileName OpenMessWin Con
  cr ." Имя_файла:" Pad &10 GetS Span ` Dup Pad 1- c! coff ;
: ShowEdWindow ShowEdScreen 
  WinEdPar Over 0 Over 1- #63 #31 OpenWindow CurrWinNo ! ;
: RestoreWindow Coff WinEdPar Dup CurrFileName &10 Cmove
  &10 + Dup ` CurrEdAdr ! 2+ Dup ` LastEdAdr !
  2+ Dup ` TxtHaveChange ! 2+ ` InsertMode ! ShowEdWindow 
  SetCursor 
  Home CurrEdAdr ` ShowList 0 0 GotoXY ResetBuf Set4Edit
  Con ; 
: ShowAllWindows Dup 1- -Dup
  If 1 Do i SetMem i ShowEdWindow Loop Then Dup SetMem ; 
: SetWindow NoFree EdID SetID Dup QWindows ` > 
   If 1 Alloc Dup >r
    If QWindows 1+! ShowAllWindows NewWinParms RestoreWindow 
    Then r>
   Else ShowAllWindows RestoreWindow
   Then ;
: SetCurrWin CurrWinNo ` RestoreWindow ;
: SetReqWindow SaveWindow ¤" Окна" OpenMessWin 
  Home ." Номер_окна( 1-" QWindows ` . ."  ):" 
  Begin 
   con Get coff Dup &b1 < 
   IfNot
    Dup QWindows ` &b0 + >
    IfNot True
    Else Drop False
    Then
   Else Drop False
   Then
  Until &b0 - SetWindow Drop False ;

( Чт./Зп.функ.-
: ReadEdFile Dup IsFile
   If 2+ c`
    If 2 OutD &20 Error Then
    Over CurrFileName &10 Cmove
    NewWinParms Over WinEdPar &10 Cmove
    Dup MaxFileLen 2* + 0 Swap ! EditorSpace Swap 3 OutD
    Drop 2 Outd EndEdSpace EditorSpace NullStr Search
    If Dup EditorSpace =  
     IfNot LastEdAdr ! EditorSpace CurrEdAdr ! SaveWindow1
     Then
    Else EndEdSpace 1- EnterKey Over c! 1+ 0 Over !
         WinEdPar &12 + ! &21 Error
    Then
   Else 2 outd &22 Error
   Then ;
: GetName&Read ¤" Чтение" GetFileName 
  If Span ` 1 = Pad c` &aa = And
   If CurrFileName c` 
    If CurrFileName ReadEdFile
    Else &23 Error
    Then
   Else Pad 1- ReadEdFile
   Then
  Then SetCurrWin False ;
: GetNm SaveWindow GetName&Read ; 
: ReadNewFile SaveWindow QWindows ` 1+ SetWindow 
  If QWindows @ CurrWinNo ! GetName&Read 
  Else &24 Error
  Then ;       
: SaveFile SaveWindow ¤" Запись" GetFileName
  If EditorSpace 0 LastEdAdr ` EditorSpace - Swab 1+ &ff
   TxtUpDate 
   And Span ` 1 = Pad c` &aa = And SysBuf &200 Erase 
   If CurrFileName c`
    If CurrFileName Swap WriteFile
    Else &23 Error
    Then
   Else Pad 1- Dup WinEdPar &10 Cmove Swap WriteFile
   Then
  Then SetCurrWin False ;

( Кнопки--
: Quit? SaveWindow ¤" Выход" OpenMessWin cr 
  ." Действительно( Y/N )?" Con Get &7f And &59 =
  If True Else SetCurrWin False Then ;

: LeftBut PosX ` If CurrBufPos 1-! LeftKey Out Then False
;
: RightBut CheckMaxX
   If CurrBufPos 1+! RightKey Out Then False ;
: UpBut StoreStr CurrEdAdr ` &ffff SkipStr Dup StrLn
   If CurrEdAdr ! PosY @ UpKey Out ShowScrollStr
   Else Drop
   Then Set4Edit False ;
: DownBut SaveWindow CurrEdAdr ` 1 SkipStr Dup StrLn 
   If CurrEdAdr ! PosY @ WinDepth @ 1- <
    DownKey Out ShowScrollStr
   Else Drop
   Then Set4Edit False ;
: PgUp CurrEdAdr ` WinDepth ` 2- Minus SkipStr 
  ShowScr&SetAdr ; 
: PgDown 
  CurrEdAdr @ WinDepth ` 2- SkipStr ShowScr&SetAdr ;
: DelEd DelStr Set4Edit False ;
: EnterEd InsertMode `
   If SaveWindow InsNullStr 
   Else DownBut Drop
   Then Set4Edit ToBegStr ResetBuf False ;
: Ins True InsertMode ` Xor InsertMode ! False SetCursor ;
: RusLat Caps False ; : Del DelSymbol False ;
: SetMyErrTrt ErrProc ` SystemErr ! myErrProc ` ErrProc !
;
: InterpretProg SaveWindow True IsBuf ! 
   0 OffsetBuf ! EditorSpace TextAdr ! 
   0 Text64 Screen ." Компилируем. Подождите..." cr 
   Here HereCore ! Con sp! Interpret RestoreHere ShowEdScreen
   CurrWinNo ` SetWindow Drop False ;  
: Default Dup OutChr c! IsCtrl
    IfNot
     CheckMaxX
     If InsertMayBe Dup CurrBufPos @ c! StrChange
      Dup Out CurrBufPos 1+!
     Then 
    Then False ;  
: TempExit SaveWindow NoFree 0 Text64 Screen 
  ." Для входа в редактор используйте EDT+<ENTER>" cr
  RestoreErr Con &ffff Error ;

EscapeKey &93 &94  UpKey DownKey LeftKey RightKey
EnterKey &91 &81 &90 &9f &82 &86 &8e &97 &85 &8f
&12 NCase EditorKeys  
TempExit SaveFile SetReqWindow ReadNewFile
GetNm InterpretProg DelEd Del RusLat Ins EnterEd 
RightBut LeftBut DownBut UpBut PgDown PgUp Quit? Default

: EditText 0 OffsetBuf ! rp! SetWindow Drop SetCursor
  Begin
   Get Dup <int Coff EditorKeys Con int> Swap Drop 
  Until RestoreErr Free 0 Text64 Screen 
  ." Вы вышли из BForthEditor..." cr
  ." Удалить редактор из памяти: FORGET BorEditor" cr 
  &ffff Error ; 
: Edt ( Простой вход в редактор
  SetMyErrTrt CurrWinNo ` EditText ;
: Editor SetMyErrTrt 0 QWindows ! 1 EditText ;
: MyErrTrt Beep 2 OutD Hex ShowEdScreen 
   PushState #16 #13 Over #32 + Over #5 + Window
   GetWindow PushWindow Home GetWindow 1 Border
   #13 0 GotoXY ." ОШИБКА" OffsetBuf ` Dup
   If
    Drop
    1 1 GotoXY ." Строка:" EditorSpace Dup OffsetBuf ` +
    CountStr Dup 1+ Decimal u. Hex 
   Then
   1 2 GotoXY Swap ." Oшибкa:" . 
   GetWindow 2Drop get drop PopWindow SP!
   PopState RestoreHere 0 HereCore ! CurrWinNo ` EditText
; ' MyErrTrt MyErrProc ! EDITOR
[an error occurred while processing this directive]