TPU Interface

{***************************************************************************}
{*                                                                         *}
{*  INTRFACE.PAS        Модуль поддержки пользовательского интерфейса      *}
{*  Ярослав Стерхов 1997 МТ7-21                 Турбо-Паскаль 5.0/7.0      *}
{*                                                                         *}
{***************************************************************************}
{$M 65520,0,655360}
UNIT IntrFace;
INTERFACE
USES CRT,Screen;
{* ОБЩИЕ СТРОКИ *}
CONST
  gStrings :ARRAY[1..4] OF STRING[80] = (
    'Большая программа Ярослава Стерхова, 1997',
    'F1 - О Программе      - Перемещение   <┘ - Выбор',
    'Esc - Выход из справки                          ',
    'Tab - Переключение   Esc - Выход    <┘ - Выбор  '
    );

{* РАБОТА С МЕНЮ *}
CONST
  MaxLen     = 18;
  MenuMargin = 2;                  {Поле отступа}
  MenuWidth = MaxLen+MenuMargin*2; {Максимальная длина строки + поле отступа}
  MenuCount = 4;                   {Кол-во элементов в меню}

{Элемент меню}
TYPE
  THelpType = procedure;
  TMenuItem = RECORD
                Name   :String[MaxLen];  { Название }
                KeyInd :Byte;            { Номер подсвеченного символа }
                Key    :SET OF Char;     { Ключевые символы }
                Proc   :Procedure;       { Вызываемая процедура}
              END;
  {Индекс меню}
  Index     = 1..MenuCount;
  {Массив меню}
  TMenuData = ARRAY[1..MenuCount] OF TMenuItem;

{Инициализация интерфейса}
PROCEDURE InitInterFace;
{Основная помощь}
PROCEDURE HelpOnProgram;
{Запуск меню}
PROCEDURE DoMenu(Title:String;Data:TMenuData; HelpProc:THelpType);

{* РАБОТА С ДИАЛОГАМИ *}
TYPE
  {функция, контролирующая правильность ввода }
  {должна возвращать FALSE, если value не соответствует нек.требованиям}
  IOFunc=FUNCTION(value:Real):Boolean;

CONST
  {Цвета диалоговой панели}
   DialogFrame :Byte    = $70;    {Black on LightGray }
   DialogButton:Byte    = $0F;    {White on Black }
   DialogSelect:Byte    = $0B;    {Cyan on Black }
   DialogShadow:Byte    = $78;    {DarkGray on LightGray}
   DialogEdit  :Byte    = $30;    {Black on Cyan }

VAR
   CurrentItem:Byte;
   HelpMenu   :THelpType;

{Изготовление кнопки}
PROCEDURE WriteButton(x,y:Byte; Str:String; len:Byte; High:Boolean);
{Рисует окошко с сообщением указанного цвета и кнопкой Ок}
PROCEDURE Message(Str:String; A:Byte);
{Рисует окошко с вопросом и кнопками Да/Нет}
FUNCTION Ask(Str:String):Boolean;
{Создает окошко с заголовком,запросом и ред.строкой, а также с кнопками}
FUNCTION AskString(Title,Str:String;Default:String;var Enter:Boolean):String;
{Создает диалог с вариантами выбора (нечто вроде меню)}
FUNCTION AskVariant(Title,Str:STRING; Count:Byte;
                       var Variant:ARRAY OF TMenuItem):Byte;
{Ввод действительного значения}
FUNCTION AskReal(Title,St:String; Default:Real;
                       var Entered:Boolean; AI:IOFunc):Real;
{Ввод целого значения}
FUNCTION AskInteger(Title,St:String; Default:Integer;
                       var Entered:Boolean; AI:IOFunc):Integer;
{Заглушка для AskReal и AskInteger}
FUNCTION DumbCheck(val:Real):Boolean;

IMPLEMENTATION

{Инициализация экрана}
PROCEDURE InitInterFace;
BEGIN
  GlobalON;   {Глобальный режим}
  FillRect(ScreenRect,'░',Attrib(Blue,LightGray)); {Заполнить экран}
  WriteChar(1,1,' ',80,Attrib(White,LightGray));   {Нижняя и верхняя полосы}
  WriteChar(1,25,' ',80,Attrib(White,LightGray));
  CenterString(1,gStrings[1],FALSE, Attrib(Black,LightGray));
  WriteString(2,25,gStrings[2],Attrib(Black,LightGray));
END;

{* РАБОТА С МЕНЮ *}
CONST
  MenuCursor = $0F;   {Цвет  курсора}
  MenuKey    = $1E;   {Цвет подсвеченых литер}
  ExitCode   = 4;     {Индекс выхода}

{Создать окно помощи}
PROCEDURE HelpOnProgram;
VAR W    :PWindow;
    PrevW:PWindow;
    a    :Byte;
    c    :Char;
    wr,op:Rect;
BEGIN
  PrevW := CurWindow;
  AssignRect(wr,10,6,71,19);
  AssignRect(op,11,7,70,18);
  A := Attrib(Black,Cyan);
  New(W);
  CreateWindow(W, 'О Программе', wr,op, a,a, TRUE);
  GlobalOFF;

  a := Attrib(Yellow,Cyan);
  CenterString(2,'Домашнее задание Ярослава Стерхова',FALSE,a);
  CenterString(3,'Группа МТ7-21',FALSE,a);
  a := Attrib(Black,Cyan);
  WriteString(1,6,'Для перемещения по меню можно использовать клавиши управления курсором'+
     ' или клавиши с выделенными буквами.',a);
  WriteString(1,WhereY+1,'Пункты главного меню:',a);
  WriteString(4,WhereY+1,'''Сортировка матрицы'' по первым элементам строк',a);
  WriteString(4,WhereY+1,'''Найти интеграл'' функции f(x) = Cos(x)/x',a);
  WriteString(4,WhereY+1,'''Построить график'' кардиоиды',a);

  a := Attrib(Black,LightGray);
  GlobalON;
  WriteString(2,25,gStrings[3],a);
  GlobalOff;
  REPEAT
    c :=ReadKey;
  UNTIL c=#27;
  HideWindow(W);
  WriteChar(1,25,' ',80,a);
  WriteString(2,25,gStrings[2],a);
  GlobalOff;
  CurWindow := PrevW;
  DisposeWindow(W);
END;

{Показать элемент}
PROCEDURE WriteItem(W:PWindow; Index:Byte; var Data: TMenuItem);
VAR
  a  : Byte;
  x  : Byte;
BEGIN
  IF CurrentItem = Index THEN a:=MenuCursor ELSE a:= W^.TextAttr;
  WriteString(MenuMargin+1, Index+1, Data.Name, a);
  IF NOT (CurrentItem = Index) THEN BEGIN  {???}
    x := MenuMargin + Data.KeyInd;
    WriteChar(x,Index+1,Data.Name[Data.KeyInd],1,MenuKey);
  END;
END;

{Показать меню}
PROCEDURE MakeMenu(var MenuWin:PWindow; var Data:TMenuData;Title:String);
CONST
  {Эта странная вещь - формула для вычисления размеров меню(см. CONST)}
  MenuRect:Rect =
            (Left: (80 - (MenuWidth + 4)) div 2 + 1;                {30}
              Top: (25 - (MenuCount + 4)) div 2 + 1;                {9}
              Right: (80 - (MenuWidth + 4)) div 2 + 4 + MenuWidth;  {51}
              Bottom:(25 - (MenuCount + 4)) div 2 + 4 + MenuCount); {16}
VAR
  Ind   : Byte;
  op    : Rect;
  PrevW : PWindow;
  a     : Byte;
BEGIN
  PrevW := CurWindow;
  CurrentItem := 1;
  op := MenuRect;
  Inc(op.Top); Inc(op.Left);
  Dec(op.Bottom); Dec(op.Right);
  a := Attrib(White,Blue);
  CreateWindow(MenuWin, Title, MenuRect,op, a,a, TRUE);
  GlobalOn;
  WriteChar(1,25,' ',80,Attrib(White,LightGray));
  WriteString(2,25,gStrings[2],Attrib(Black,LightGray));
  GlobalOff;
  FOR Ind := 1 TO MenuCount DO
    WriteItem(MenuWin,Ind,Data[Ind]);

END;

{Получить номер выбранного элемента}
FUNCTION GetChoice(var W:PWindow; Data:TMenuData;Title:String):Index;
VAR
  Chosed:Boolean;
  c,cc  :Char;
  pi, i :Index;
BEGIN
  Chosed := FALSE;
  MakeMenu(W,Data,Title);
  REPEAT
    c := ReadKey;
    FOR I:=1 TO MenuCount DO
      IF c IN Data[i].Key THEN BEGIN
         pi := CurrentItem;
         CurrentItem := i;
         WriteItem(W,pi,Data[pi]);
         WriteItem(W,i,Data[i]);
         Chosed:= TRUE;
         GetChoice := i;
       END;

     IF NOT Chosed THEN
       CASE c OF
         #27: BEGIN
                GetChoice:=ExitCode;
                Chosed:=TRUE;
              END;
         #13: BEGIN
                GetChoice:=CurrentItem;
                Chosed :=TRUE;
              END;
         #00: BEGIN
                cc := ReadKey;
                pi := CurrentItem;
                CASE cc OF
                  #59        : HelpMenu;
                  #71,#73,#75: CurrentItem:=1;
                  #72        : IF CurrentItem=1 THEN CurrentItem:=MenuCount
                                 ELSE Dec(CurrentItem);
                  #80        : IF CurrentItem=MenuCount THEN CurrentItem:=1
                                 ELSE Inc(CurrentItem);
                  #77,#79,#81: CurrentItem:=MenuCount;
                END;
                IF pi<>CurrentItem THEN BEGIN
                  WriteItem(W,pi,Data[pi]);
                  WriteItem(W,CurrentItem,Data[CurrentItem]);
                END;
              END;
     END;
  UNTIL Chosed;
END;

{Запуск меню}
PROCEDURE DoMenu(Title:String;Data:TMenuData;HelpProc:THelpType);
VAR
 W      :PWindow;
 choice :Index;
BEGIN
  HelpMenu:=HelpProc;
  New(W);
  REPEAT
    choice:=GetChoice(W,Data,Title);
    HideWindow(W);
    Data[choice].Proc;
  UNTIL choice = ExitCode;
END;

{* РАБОТА С ДИАЛОГАМИ *}

                            {Изготовление кнопки}
{         }
{   Ok   ▄}
{ ▀▀▀▀▀▀▀▀}
PROCEDURE WriteButton(x,y:Byte; Str:String; len:Byte; High:Boolean);
VAR
  dx:Byte;
BEGIN
  WriteChar(x,y,' ',Len,DialogButton);
  dx := (len - Length(Str)) div 2;
  WriteString(x+dx,y,Str,DialogButton);
  WriteChar(x+1,y+1,'▀',Len,DialogShadow);
  WriteChar(x+Len,y,'▄',1,DialogShadow);
  IF High THEN BEGIN
    WriteChar(x,y,' ',1,DialogSelect);
    WriteChar(x+Len-1,y,' ',1,DialogSelect);
  END;
END;

{Рисует окошко с сообщением указанного цвета и кнопкой Ок}
PROCEDURE Message(Str:String; A:Byte);
VAR
  W, PrevW : PWindow;
  wr,op    : Rect;
  bx       : Byte;
  c        : Char;
BEGIN
  PrevW := CurWindow;
  AssignRect(wr, (76-Length(Str)) div 2 + 1,9,(76-Length(Str)) div 2 + 5 + Length(Str),15);
  op := wr;
  Inc(op.Top); Inc(op.Left);
  Dec(op.Bottom); Dec(op.Right);
  New(W);
  CreateWindow(W, 'Сообщение', wr,op, A,A, TRUE);
  DialogShadow:= (A AND $F0) OR $78;

  {Изменение нижней статус-строки}
  GlobalOn;
  WriteChar(1,25,' ',80,Attrib(Black,LightGray));
  WriteString(2,25,'Enter - Продолжить',Attrib(Black,LightGray));
  GlobalOFF;

  WriteString(2,2,Str,A);
  bx := (W^.WinRect.Right - W^.WinRect.Left) div 2 - 4;
  WriteButton(bx,4,'Ok',8,TRUE);
  REPEAT
    c := ReadKey;
  UNTIL c=#13;
  HideWindow(W);
  DisposeWindow(W);
  CurWindow := PrevW;
  DialogShadow:=$78;
END;

{Рисует окошко с вопросом и кнопками Да/Нет}
FUNCTION Ask(Str:String):Boolean;
VAR
  W,PrevW:PWindow;
  wr,op  :Rect;
  i      :Byte;
  Answer :Byte;
  Chosed :Boolean;
  Ch,Ch2 :Char;
CONST
   Buttons :ARRAY[1..2] OF RECORD
                   x,y:Byte;
                   Len:Byte;
                   Name:String;
               END =
   ((X:7; Y:5; Len:9 ;Name:'Нет'),
   (X:23; Y:5; Len:8 ;Name:'Да'));

BEGIN
  PrevW := CurWindow;
  Answer := 1;
  AssignRect(wr,20,9,60,16);
  AssignRect(op,22,10,58,15);
  New(W);
  CreateWindow(W, 'Вопрос', wr,op, DialogFrame,DialogFrame, TRUE);

  {Изменение нижней статус-строки}
  GlobalOn;
  WriteChar(1,25,' ',80,Attrib(Black,LightGray));
  GlobalOFF;

  FOR I:=1 TO 2 DO BEGIN
    WITH Buttons[I] DO
      WriteButton(X,Y,Name,Len,FALSE);
  END;

  WITH Buttons[Answer] DO WriteButton(X,Y,Name,Len,TRUE);
  CenterString(2,Str,TRUE,DialogFrame);

  {Далее алгоритм ожидания выбора}
  Chosed := FALSE;
  REPEAT
    Ch := ReadKey;
    CASE Ch OF
      'Y','y','Д','д': BEGIN
                         Answer := 2;
                         Chosed := True;
                       END;
      'N','n','Н','н': BEGIN
                         Answer := 1;
                         Chosed := True;
                       END;
{Enter}#13           : Chosed := TRUE;
{Tab} #9             : IF Answer=2 THEN Answer:=1 ELSE Inc(Answer);
{...} #00            : BEGIN
                         Ch2 := ReadKey;
                         CASE Ch2 OF
      {Left}{Shift-Tab}    #15,#75: IF Answer=1 THEN Answer:=2
                                       ELSE Dec(Answer);
                {Right}    #77    : IF Answer=2 THEN Answer:=1
                                       ELSE Inc(Answer);
                         END;
                       END;
    END;

    FOR I:=1 TO 2 DO
      WITH Buttons[I] DO  WriteButton(X,Y,Name,Len,FALSE);
    WITH Buttons[Answer] DO WriteButton(X,Y,Name,Len,TRUE);
  UNTIL Chosed;
  IF Answer=1 THEN Ask:=FALSE ELSE Ask:=TRUE;
  HideWindow(w);
  CurWindow:= PrevW;
  DisposeWindow(W);
END;

{Создает окошко с заголовком,запросом и ред.строкой, а также с кнопками}
FUNCTION AskString(Title,Str:String;Default:String;var Enter:Boolean):String;
VAR
  W,PrevW      :PWindow;
  wr,op        :Rect;
  Temp,Answer  :String;
  Chosed       :Boolean;
  Ch,Ch2       :Char;
  Cmd          :1..2;
  Pos,I        :Byte;
CONST
  {Допустимые символы}
  Letters :SET OF Char = [#32..#126,#128..#255];
  {Кнопки}
  Buttons :ARRAY[1..2] OF RECORD
                   x,y:Byte;
                   Len:Byte;
                   Name:String;
               END =
   ((X:30; Y:4; Len:8 ;Name:'Ввод'),
   (X:41; Y:4; Len:8 ;Name:'Отмена'));

BEGIN
  {Создание окна}
  PrevW := CurWindow;
  Cmd := 1;   { Команда: 1 - ВВОД, 2 - ОТМЕНА  }
  Pos := 1;   { Позиция курсора в редактируемой строке }
  AssignRect(wr,14,9,67,15);
  AssignRect(op,16,10,65,14);
  New(W);
  CreateWindow(W, Title, wr,op, DialogFrame,DialogFrame, TRUE);
  Answer := Default;
  {Обрезаем начальные пробелы}
  WHILE Answer[Pos]=#32 DO
    Inc(Pos);

  Answer:=Copy(Answer,Pos,Length(Answer)-Pos+1);
  Pos:=1;
  {Изменение нижней статус-строки}
  GlobalOn;
  WriteChar(1,25,' ',80,Attrib(Black,LightGray));
  WriteString(2,25, gStrings[4],Attrib(Black,LightGray));

  {Отрисовка окна}
  GlobalOFF;
  FOR I:=1 TO 2 DO BEGIN
    WITH Buttons[I] DO
      WriteButton(X,Y,Name,Len,FALSE);
  END;
  WITH Buttons[Cmd] DO WriteButton(X,Y,Name,Len,TRUE);
  WriteString(1,1,Str,DialogFrame);
  WriteChar(1,2,' ',50,DialogEdit);
  WriteString(1,2,Answer,DialogEdit);
  ShowCursor;
  GotoXY(Pos,2);
  {Далее алгоритм ожидания выбора и редактирования строки}
  Chosed := FALSE;
  REPEAT
    Ch := ReadKey;
    IF (ch IN Letters) AND (Length(Answer)< 50) THEN BEGIN
                       Temp:=Ch;
                       Insert(Temp,Answer,Pos);
                       Inc(Pos);
                     END;
    CASE Ch OF
{BkSp}#8             : IF Pos>1 THEN BEGIN
                         Temp:=Copy(Answer,1,Pos-2)+Copy(Answer,Pos,Length(Answer));
                         Answer:=Temp;
                         Dec(Pos);
                       END;
{Enter}#13           : BEGIN
                         Chosed := True;
                       END;
{Esc} #27            : BEGIN
                         Cmd := 2;
                         Chosed := True;
                         Enter:=False;
                       END;
{Tab} #9             : IF Cmd=2 THEN Cmd:=1 ELSE Cmd:=2;
{...} #00            : BEGIN
                         Ch2 := ReadKey;
                         CASE Ch2 OF
                   {Left}  #75   : IF Pos > 1 THEN Dec(Pos);
                   {Right} #77    : IF Pos < Length(Answer) THEN Inc(Pos);
                   {Del}   #83    : BEGIN
                                      Temp:=Copy(Answer,1,Pos-1)+Copy(Answer,Pos+1,Length(Answer));
                                      Answer:=Temp;
                                    END;
                         END;
                       END;
    END;

    FOR I:=1 TO 2 DO
      WITH Buttons[I] DO  WriteButton(X,Y,Name,Len,FALSE);
    WITH Buttons[Cmd] DO WriteButton(X,Y,Name,Len,TRUE);

    WriteChar(1,2,' ',50,DialogEdit);
    WriteString(1,2,Answer,DialogEdit);
    GlobalOff;
    GotoXY(Pos,2);
    ShowCursor;
  UNTIL Chosed;
  HideCursor;

  Enter:=(Cmd=1);
  AskString:=Answer;

  HideWindow(W);
  CurWindow:= PrevW;
  DisposeWindow(W);
  GlobalOn;
  WriteChar(1,25,' ',80,Attrib(Black,LightGray));
  GlobalOff;
END;

{Создает диалог с вариантами выбора}
FUNCTION AskVariant(Title,Str:STRING; Count:Byte;
                                      var Variant:ARRAY OF TMenuItem):Byte;
VAR
  W,PrevW   :PWindow;
  wr,op     :Rect;
  Ind       :Byte;
  Chosed    :Boolean;
  c,cc      :Char;
  pi, i     :Byte;
  Choice    :Byte;
  a         :Byte;
BEGIN
  PrevW := CurWindow;
  CurrentItem := 1;
  AssignRect(wr,(80 - (MenuWidth + 4)) div 2 + 1,
              (25 - (Count + 4)) div 2 - 1,
              (80 - (MenuWidth + 4)) div 2 + 4 + MenuWidth,
              (25 - (Count + 4)) div 2 + 4 + Count);
  op := wr;
  Inc(op.Top); Inc(op.Left);
  Dec(op.Bottom); Dec(op.Right);
  a := Attrib(White,Blue);
  New(W);
  CreateWindow(W, Title, wr,op, a,a, TRUE);

  GlobalOn;
  WriteChar(1,25,' ',80,Attrib(Black,LightGray));
  WriteString(2,25,gStrings[2],Attrib(Black,LightGray));
  GlobalOFF;

  WriteString(2,2,Str,Attrib(Yellow,Blue));

  op := W^.OutPut;
  Inc(op.Left,1);
  Inc(op.Top,3);
  W^.OutPut := op;
  CurWindow:=W;

  FOR Ind := 0 TO Count-1 DO
    WriteItem(W,Ind,Variant[Ind]);

  Chosed := FALSE;
  REPEAT
    c := ReadKey;
    FOR I:=0 TO Count-1 DO
      IF c IN Variant[i].Key THEN BEGIN
         pi := CurrentItem;
         CurrentItem := i;
         WriteItem(W,pi,Variant[pi]);
         WriteItem(W,i,Variant[i]);
         Chosed:= TRUE;
         Choice := i;
       END;

   IF NOT Chosed THEN
       CASE c OF
         #13: BEGIN
                Choice:=CurrentItem;
                Chosed :=TRUE;
              END;
         #00: BEGIN
                cc := ReadKey;
                pi := CurrentItem;
                CASE cc OF
                  #59        : {Убрано за ненадобностью};
                  #71,#73,#75: CurrentItem:=0;
                  #72        : IF CurrentItem=0 THEN CurrentItem:=Count-1
                                 ELSE Dec(CurrentItem);
                  #80        : IF CurrentItem=Count-1 THEN CurrentItem:=0
                                 ELSE Inc(CurrentItem);
                  #77,#79,#81: CurrentItem:=Count-1;
                END;
                IF pi<>CurrentItem THEN BEGIN
                  WriteItem(W,pi,Variant[pi]);
                  WriteItem(W,CurrentItem,Variant[CurrentItem]);
                END;
              END;
     END;
  UNTIL Chosed;
  AskVariant:=Choice+1;
  HideWindow(W);
  CurWindow:=PrevW;

  GlobalOn;
  WriteChar(1,25,' ',80,Attrib(Black,LightGray));
  GlobalOff;
  DisposeWindow(W);
END;

{Заглушка для AskReal и AskInteger}
FUNCTION DumbCheck(val:Real):Boolean;
BEGIN
   DumbCheck:=TRUE;
END;

{Ввод действительного значения}
FUNCTION AskReal(Title,St:String; Default:Real;
                 var Entered:Boolean; AI:IOFunc):Real;
VAR
  S,def :String;
  code  :Integer;
  tVal  :Real;
  Enter :Boolean;
BEGIN
 Str(Default:6:3,def);
 REPEAT
  S := AskString(Title,St,Def,Enter);
  Val(S,tVal,code);
  IF Enter THEN IF code<>0 THEN
      Message('Не похоже на число!',Attrib(Yellow,Red));
  IF (code=0) AND Enter THEN IF NOT AI(tVal) THEN code:=1;
 UNTIL (code=0);
 Entered:=Enter;
 AskReal:=tVal;
END;

{Ввод целого значения}
FUNCTION AskInteger(Title,St:String; Default:Integer;
                       var Entered:Boolean; AI:IOFunc):Integer;
VAR
  S,def :String;
  code  :Integer;
  tVal  :Integer;
  Enter :Boolean;
BEGIN
 Str(Default,def);
 REPEAT
  S := AskString(Title,St,Def,Enter);
  Val(S,tVal,code);
  IF Enter THEN
    IF code<>0 THEN
      Message('Не похоже на число!',Attrib(Yellow,Red));
  IF (code=0) AND Enter THEN IF NOT AI(tVal) THEN code:=1;
 UNTIL (code=0);
 Entered:=Enter;
 AskInteger:=tVal;
END;

{Инициализация}
BEGIN
  InitInterFace;
END.