[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]