(* 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.
|