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

(* OKHO_FMS использует: TYPE_FMS  *)
(*                      UNIF_FMS  *)

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

Uses CRT, UNIF_FMS, TYPE_FMS;

TYPE    Todul = array [1..5] of String[5];

CONST   Podul:Todul = ('+++++',
                       '| | |',
                       '+++++',
                       '| | |',
                       '+++++');
        Wodul:Todul = ('+-+-+',
                       '| | |',
                       '+-+-+',
                       '| | |',
                       '+-+-+');

        TheSCR:byte = 0;  { Текущий номер видео страницы - см. PgSCR }

TYPE    EltSCR =  record txt : char; att : byte end;
        LinSCR =  array [1.. 80] of EltSCR;
        TypSCR =  array [1.. 25] of LinSCR;
        Alfa   =  String[80];

VAR        SCR : TypSCR  absolute $B800:$0000;
        AltSCR : TypSCR  absolute $B900:$0000;
        LinWRK : LinSCR;

procedure PgSCR(Pg : byte);

procedure    EmpWin(XH,YH,XK,YK : integer; A : integer);

procedure    LineOn(    L : integer                       );
procedure       ICH(    L : integer; C : char; A : integer);
procedure       ISC(  X,Y : integer; C : char; A : integer);
procedure In_LinWRK(var L : integer; S : alfa; A : integer);
procedure On_LinWRK(    L : integer; S : alfa; A : integer);
procedure Em_LinWRK(                       H,K,A : integer);

procedure OnScrXYA(X,Y,A : integer; S : String);
procedure OnScrCYA(Y,A   : integer; S : String);

procedure Line_25(S : String);

                        IMPLEMENTATION

{ PgSCR : Pg = 0 | 1 | .... - номер видимой страницы }

procedure PgSCR(Pg : byte);
begin   if Pg = TheSCR then Exit;
        TheSCR:=Pg;
        asm MOV AL, Pg
            MOV AH, 5
            INT $10
        end                  end;

procedure EmpWin(XH,YH,XK,YK : integer; A : integer);
   var I,J : integer;
         E : EltScr;
begin   E.txt:=' ';
        E.att:=A;
        for J:=XH to XK do if (1 <= J) and (J <= 80) then
        for I:=YH to YK do if (1 <= I) and (I <= 25) then SCR[I,J]:=E end;

procedure LineOn(L : integer);
   var LinFSC : LinSCR;
          H,K : integer;
   function NEQ(N : integer) : boolean;
   begin    NEQ:=(LinFSC[N].att <> LinWRK[N].att) or
                 (LinFSC[N].txt <> LinWRK[N].txt)
   end;
begin   LinFSC:=SCR[L];
        for H:=1      to 80 do if NEQ(H) then
        for K:=80 downto  H do if NEQ(K) then begin
           Move(LinWRK[H],SCR[L,H],2*(K-H+1));
           Exit
        end                                     end;

procedure ISC(X,Y : integer; C : char; A : integer);
begin   SCR[Y,X].txt:=C;
        SCR[Y,X].att:=A                         end;

procedure ICH(L : integer; C : char; A : integer);
begin   if  L < 1 then Exit;
        if 80 < L then Exit;
        LinWRK[L].txt:=C;
        LinWRK[L].att:=A                      end;

procedure In_LinWRK(var L : integer; S : alfa; A : integer);
   var I : integer;
begin   for I:=1 to Length(S) do begin
           L:=L+1;
           ICH(L,S[I],A)
        end                                             end;

procedure On_LinWRK(L : integer; S : alfa; A : integer);
begin     In_LinWRK(L,S,A)                          end;

procedure Em_LinWRK(H,K,A : integer);
   var I : integer;
begin   for I:=H to K do ICH(I,' ',A) end;

procedure OnScrXYA(X,Y,A : integer; S : String);
   var I : integer;
begin   X:=X-1;
        if (1 <= Y) and (Y <= 25) then
        for I:=X+1 to X+Length(S) do
        if (1 <= I) and (I <= 80) then ISC(I,Y,S[I-X],A)   end;

procedure OnScrCYA(Y,A : integer; S : String);
begin     ONScrXYA(41-Length(S) div 2,Y, A,S)      end;

procedure Line_25(S : String);
   const PLbar = $30;
   var L : integer;
       A : char;
begin   S:=Csps(6)+S;
        L:=-1;
        for A:='1' to '9' do begin
           In_LinWRK(L,       ' '+A        ,$07  );
           In_LinWRK(L,Copy(S,Pos(A,S)+1,6),PLbar)
        end;
        In_LinWRK(L,' 10'   ,  $07);
        In_LinWRK(L,'Выход ',PLbar);
        LineOn(25)                             end;

end.