C.Ю.Соловьев

Методические материалы
по курсу
"Алгоритмы и алгоритмические языки"

Программа курса  >>  Пример "большой" программы  >>  Модуль STAK_FMS

(* STAK_FMS использует: CRUF_FMS  *)
(*                      FILE_FMS  *)
(*                      UNIF_FMS  *)

{$A+,B-,D-,E+,F-,G-,I+,L+,N-,O-,R+,S+,V+,X-}
{$M 16384,0,65536}
unit STAK_FMS;              INTERFACE

const _Ostk_ : boolean = false;  { Стек открыт ? }
var   _Fstk_ : file;             { Файл стека    }

procedure PUSH(var V; KOL : word);
procedure  POP(var V            );

function     Get_SP          : LongInt ;
procedure Return_SP(OldSP    : LongInt);
function  SavPUSH(var V; KOL : word   ) : LongInt;
procedure ResPOP (var V; OSP : LongInt);

var   VideoScurs : boolean; { true - курсор на экране;  false - отсутствует }
      Mode_Scurs : boolean; { true - Last = Save_Scurs; false - Rest_Scurs  }

procedure Init_Scurs;
procedure Save_Scurs;
procedure Rest_Scurs;
procedure Goto_Scurs(X,Y : integer);
procedure CuSh(B : boolean);

                            IMPLEMENTATION

uses DOS, CRT, UNIF_FMS, CRUF_FMS, FILE_FMS;

var    SX,SY : integer;

procedure PUSH(var V; KOL : word);
begin   if          _Ostk_        then
        if PushFile(_Fstk_,V,KOL) then   end;

procedure POP(var V);
begin   if          _Ostk_    then
        if Pop_File(_Fstk_,V) then   end;

function SavPUSH(var V; KOL : word) : LongInt;
begin      PUSH(V,KOL);
        SavPUSH:=Get_SP                   end;

procedure ResPOP(var V; OSP : LongInt);
begin     Return_SP(OSP);
          POP(V)                    end;

function Get_SP : LongInt;
begin   if _Ostk_ then Get_SP:=FilePos(_Fstk_)
                  else Get_SP:=0           end;

procedure Return_SP(OldSP : LongInt);
begin   if          _Ostk_        then
        if SeekFile(_Fstk_,OldSP) then    end;

(************************************
procedure SAVE_STACK(Fname : String);
begin   Close(F);
        Rename(F,Fname)          end;
************************************)

procedure Save_Scurs;
begin   if Mode_Scurs then Exit
                      else Mode_Scurs:=true;
        if VideoScurs then
                      else Exit;
        SX:=WhereX;
        SY:=WhereY;
        asm
           mov bh,0
           mov ah,2
           mov dl,0
           mov dh,50
           int $10
        end                             end;

procedure Rest_Scurs;
begin  if Mode_Scurs then Mode_Scurs:=false
                     else Exit;
       if VideoScurs then
                     else Exit;
       if SX <  1 then SX:=1;
       if SX > 80 then SX:=1;
       if SY <  1 then SY:=1;
       if SY > 25 then SY:=1;
       GotoXY(SX,SY)                    end;

procedure Init_Scurs;
begin   VideoScurs:=true;
        Mode_Scurs:=false;
        GotoXY(1,1);
        Save_Scurs    end;

procedure Goto_Scurs(X,Y : integer);
begin   SX:=X;
        SY:=Y;
        Mode_Scurs:=true;
        VideoScurs:=true;
        Rest_Scurs              end;

procedure Show_Scurs(S : boolean);       { true  : курсор - на экран  }
   var VS : boolean;                     { false : курсор - с  экрана }
begin   if VideoScurs = S then Exit;     { Mode_Scurs:=S; - непонятно }
        if S then       Mode_Scurs:=true
             else begin Mode_Scurs:=false; Save_Scurs end;
        VideoScurs:=S                                 end;

{  Show_Scurs(false); | Типовая схема  }
{  ..... меню ....... | отключения     }
{  Show_Scurs(true);  | курсора для    }
{  Rest_Scurs;        | редактора MGE  }

procedure CuSh(B : boolean);
begin             Show_Scurs(B);
        if B then Rest_Scurs   end;

end.

Вопросы?