[an error occurred while processing this directive]

<pre>


( Программа для демонстрации возможностей BForth 

( Данная программа реализует просмотр текстовых файлов 
( на любом устройстве АГАТ( которое зарегистрировалось ) 

( Кнопки: ESC- выход из любого меню 
( В основном режиме: "."- смена логического устройства 
(                  ENTER- просмотр выбранного файла 

( Написана 10.94 

Hex 

0 Variable Aborted 
: Aborted? Aborted ` False Aborted ! ; 
: Aborted! True Aborted ! ; 

( Блок работы для смены устройства------------------------ 
: SetBrdPlace Dup 2* 2 ` + WinX ` + 3 - 1 WinY @ + Over 2+ 
              Over 2+ ; 
: LMenu Dup 1 = IfNot 1- Then False ; 
: RMenu Dup 0 ` = IfNot 1+ Then False ; 
: EscMenu Drop 0 True ; 

RightKey LeftKey EscapeKey EnterKey 4 
NCase MenuSw 
True EscMenu LMenu RMenu False 

: ShowMenu      ( Покажем меню для устройств
  PushState Coff Dup 
  2* 2+ &curren;" Устройства" Dup c` 3 + Rot Max 0 ! ( Длина рамки 
  WinWidth ` 0 ` - 2/ ( Координата по X рамки 
  WinDepth ` 4 - 2/   ( По Y 
  Over 0 ` + 
  Over 4 + Window     ( Объявим окно 

  GetWindow 1 Border WinWidth ` Over c` - 2/ 0 GotoXY 
  Outs      ( Выведем название рамки 
  0 !       ( Число устройств в 0 
  WinWidth ` 0 ` 2* - 2/ 1+ Dup 2 ! 2 GotoXY 
  0 ` 1 Do  ( Цикл по всем устройствам 
   i &amp;c0 + Out Space 
  Loop 
  1         ( Текущее устройство 
( В 2 координата по X для 1 устройства 
  Begin 
   SetBrdPlace 0 Border 
   Get 
   &gt;r SetBrdPlace 3 Border r&gt; 
   MenuSW 
  Until 
  PopState 
; 

: SetReqDev     ( Установим логическое УСТРОЙСТВО по номеру 
   2 0 c! &amp;40 + 1 c! &amp;3a 2 c! 
   0 2 Latest Pfind ( Найдем слово или нет 
   If
    Drop  ( Удалим длину слова
    Cfa   ( Выдадим адрес на исполнение 
    Exec True
   Else
    False
   Then
;

: ChangeDrive   ( Сменим активное логическое УСТРОЙСТВО 
   QLogDev `    ( Число УСТРОЙСТВ на стек 
   ShowMenu     ( Покажем меню
   SetReqDev    ( Установим требуемое устройство
;  

( Блок работы с файловой структурой--------------------- 
&amp;11 &curren;Variable MyFileName 

: BcUp Dup Bank5 = 
   IfNot 2- &amp;20 0 Do 1- Dup c` &amp;20 &lt; 
                   If leave Then 
                  Loop 
    UpKey Out 
   Then False 
; 

: BcDown Dup Count + 2+ Dup c` 
   If DownKey Out Else Drop Then False ; 

: BcEnter Dup &gt;r Dup Count 1+ + c` 
   If Beep 
    Else 
     1 Text64 Screen Drop 
     MyFileName &curren;! 
     2 setmem MyFileName Bank5 ReadFile 
     ." Просмотр файла:" MyFileName OutS cr 
     ." ---------------------------------------------------" 
     GetWindow 2Swap 2+ 2Swap Window Bank5 
     Begin 
      Dup Dup WinDepth ` 1- SkipStr Dup &gt;r Over - Type 
      ." Nажмите любую клавишу" Get EscapeKey = 
      If Lev True 
       Else i r&gt; c` 0= ToBegStr WinWidth ` 1- spaces 
            ToBegStr 
      Then 
     Until 
     Drop SwapsPar ShowScreen 1 setmem 
   Then sp! r&gt; False ; 

: FillEndStr PushState Dup Outs &amp;10 Over c` - Spaces 
             PopState ; 

: SetInverseLine Inverse FillEndStr ; 
: SetNormalLine Normal FillEndStr ; 

0 Variable AllFiles 

&amp;81 Constant BcId 

: ShowCatalog  0 AllFiles ! Home 
  bank5 1 5 OutD Coff 
  Bank5 WinDepth ` 1- 0 
  Do 
   Dup c` 
   If 
    Count 2Dup Type 2+ + AllFiles 1+! 
   Else 
    Leave 
   Then 
   i i' = IfNot Cr Then 
  Loop Drop 0 0 GotoXY 
; 

: BcChDrive 1 Text32 Screen Drop ChangeDrive SwapsPar 
  ShowScreen If Drop ShowCatalog Bank5 Then False ; 

&amp;82 UpKey DownKey EnterKey EscapeKey 5 NCase BcKeys 
True BcEnter BcDown BcUp BcChDrive False 

: TypeFiles 
   BcId SetId 2 alloc 
   IfNot ." Нет памяти для программы" get 
   Else 
    1 setmem 0 Text32 Screen Drop ." BForth TextViewer" 
    cr ." --------------------" 
    GetWindow 2Swap 2+ 2Swap Window &curren;" *.*" ShowCatalog 
    Bank5 Begin SetInverseLine Get &gt;r SetNormalLine r&gt; 
    BcKeys Until 
   Then Free 
; 

TypeFiles 

</pre>

[an error occurred while processing this directive]