Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MINIGEN.ZIP/MGPROG.INC

Text File | 1988-01-07 | 23.3 KB | 934 lines

{** Start of EHSPROG.INC Copyright (c) 1987 Eric H. Snyder **}

{ Must declare a Const ScreenCount = the # of windows being defined !!!! }

Type
  Exitstyp       =  Set of Byte;
  Str80          =  String[80];
  WorkScreenPtr  = ^ScreenImage;
  ScreenImage    =  array[1..25,1..80] of integer;
  ScreenDef      =  Record
                    X1,Y1,X2,Y2,BgCol,FrameTyp,FrCol : Byte;
                    End;
  SavedScreen    = ^SavedScreenRec;
  SavedScreenRec =  Record
                    BackLink        : SavedScreen;
                    XLoc,Yloc       : Integer;
                    ScreenStats     : ScreenDef;
                    SavedScreen     : ScreenImage;
                    End;
  SG_Regs    = Record
               AX,BX,CX,DX,BP,DI,SI,DS,ES,Flags : Integer;
               End;
  FrameChars = Record
               TL,TR,BL,BR,HC,VC : Char;
               End;

Const           { Delete unused frame character constant records }
  SingleBar   : FrameChars = (TL:#218;TR:#191;BL:#192;BR:#217;HC:#196;VC:#179);
  DoubleBar   : FrameChars = (TL:#201;TR:#187;BL:#200;BR:#188;HC:#205;VC:#186);
  Horiz2Vert1 : FrameChars = (TL:#213;TR:#184;BL:#212;BR:#190;HC:#205;VC:#179);
  Vert2Horiz1 : FrameChars = (TL:#214;TR:#183;BL:#211;BR:#189;HC:#196;VC:#186);
  {**}
  TopSingle   : FrameChars = (TL:#194;TR:#194;BL:#192;BR:#217;HC:#196;VC:#179);
  TopDouble   : FrameChars = (TL:#203;TR:#203;BL:#200;BR:#188;HC:#205;VC:#186);
  TopH2V1     : FrameChars = (TL:#209;TR:#209;BL:#212;BR:#190;HC:#205;VC:#179);
  TopV2H1     : FrameChars = (TL:#210;TR:#210;BL:#211;BR:#189;HC:#196;VC:#186);
  {**}
  LastOpened  : ScreenDef  = (X1:0;Y1:0;X2:81;Y2:26;BgCol:0;FrameTyp:0;FrCol:0);
  FirstScreen : Boolean    = True;

Var
  PhysicalScreen      : ^Char;
  WorkScreen          :  WorkScreenPtr;
  CurrentScreen,
  NewScreen           :  SavedScreen;
  DefinedScreens      :  Array[1..ScreenCount] of ScreenDef;
  TestInt             : Integer;
  TestByte            : Byte;
  TestReal            : Real;
  TestStr             : String[80];
  Result              : Integer;
  UpperByte,LowerByte : Byte;                   { Used                    }
  UpperInt,LowerInt   : Integer;                {      in range           }
  UpperReal,LowerReal : Real;                   {               checking  }
  SG_Registers        : SG_Regs;
  ScreenType          : Char;

Procedure InitializeScreens;
Begin
New(WorkScreen);
If Mem[$0040:$0049] = 7 then
  Begin
  PhysicalSCreen := Ptr($B000,$0000);
  ScreenType     := 'M';
  End
Else
  Begin
  PhysicalScreen := Ptr($B800,$0000);
  ScreenType     := 'C';
  End;
End; {InitScreen}

Procedure DefineScreen(Ind,dfX1,dfY1,dfX2,dfY2,dfBgCol,dfFrameTyp,dfFrCol:Byte);
Begin
With DefinedScreens[Ind] do
  Begin
  X1       := dfX1;
  Y1       := dfY1;
  X2       := dfX2;
  Y2       := dfY2;
  BgCol    := dfBgCol;
  FrameTyp := dfFrameTyp;
  FrCol    := dfFrCol;
  End;
End;

Procedure MakeFrame(X1,Y1,X2,Y2,BgCol,FrameTyp,FrCol : Byte;
                                               Frame : FrameChars);
Var
  TopLine,BodyLine,BottomLine : Str80;
  I : Integer;

Procedure Rite(S:Str80;X,Y:Byte;Attr:Integer);
Var
  I  : Integer;
Begin
Attr := Attr shl 8;
For I := 1 to Length(S) do
  MemW[Seg(WorkScreen^):(Y-1)*160+(X+I-2)*2] := Attr or Ord(S[I]);
End; {Rite}

Begin
With Frame do
  Begin
  {**}                                {Make the top line}
  TopLine[1] := TL;
  FillChar(TopLine[2],((X2-X1)-1),HC);
  TopLine[((X2-X1)+1)] := TR;
  TopLine[0] := Chr(Ord((X2-X1)+1));
  {**}                                {Make the body line}
  BodyLine[1] := VC;
  FillChar(BodyLine[2],((X2-X1)-1),' ');
  BodyLine[((X2-X1)+1)] := VC;
  BodyLine[0] := Chr(Ord((X2-X1)+1));
  {**}                                {Make the bottom line}
  BottomLine[1] := BL;
  FillChar(BottomLine[2],((X2-X1)-1),HC);
  BottomLine[((X2-X1)+1)] := BR;
  BottomLine[0] := Chr(Ord((X2-X1)+1));
  End;
Window(X1,Y1,X2,Y2);
Move(PhysicalScreen^,WorkScreen^,4000);
Rite(TopLine,X1,Y1,FrCol);
For I := (Y1+1) to (Y2-1) do
  Rite(BodyLine,X1,I,FrCol);
Rite(BottomLine,X1,Y2,FrCol);
Move(WorkScreen^,PhysicalScreen^,4000);
Window(X1+1,Y1+1,X2-1,Y2-1);
TextBackground(BgCol);
ClrScr;
End; {MakeFrame}

Procedure OpenWindow(Ind:Byte);
Var
  SD : ScreenDef;
Begin
New(NewSCreen);
With NewScreen^ do
  Begin
  XLoc := WhereX;
  YLoc := WhereY;
  Move(PhysicalScreen^,SavedScreen,4000);
  ScreenStats := LastOpened;
  If FirstScreen then
    Begin
    BackLink      := nil;
    FirstScreen   := False;
    End
  Else
    BackLink      := CurrentScreen;
  CurrentScreen := NewScreen
  End;
SD := DefinedScreens[Ind];
With SD do
  Begin
  Case SD.FrameTyp of
    1 : MakeFrame(X1,Y1,X2,Y2,BgCol,FrameTyp,FrCol,SingleBar);
    2 : MakeFrame(X1,Y1,X2,Y2,BgCol,FrameTyp,FrCol,DoubleBar);
    3 : MakeFrame(X1,Y1,X2,Y2,BgCol,FrameTyp,FrCol,Horiz2Vert1);
    4 : MakeFrame(X1,Y1,X2,Y2,BgCol,FrameTyp,FrCol,Vert2Horiz1);
    5 : MakeFrame(X1,Y1,X2,Y2,BgCol,FrameTyp,FrCol,TopSingle);
    6 : MakeFrame(X1,Y1,X2,Y2,BgCol,FrameTyp,FrCol,TopDouble);
    7 : MakeFrame(X1,Y1,X2,Y2,BgCol,FrameTyp,FrCol,TopH2V1);
    8 : MakeFrame(X1,Y1,X2,Y2,BgCol,FrameTyp,FrCol,TopV2H1);
    End;
  End;
LastOpened := SD;
End; {OpenWindow}

Procedure CloseWindow;
Begin
NewScreen := CurrentScreen;
With NewScreen^ do
  Begin
  Move(SavedScreen,PhysicalScreen^,4000);
  With ScreenStats do
    Window(X1+1,Y1+1,X2-1,Y2-1);
  GotoXY(XLoc,YLoc);
  LastOpened := ScreenStats;
  If BackLink <> Nil then
    CurrentScreen := BackLink;
  End;
Dispose(NewScreen);
End; {CloseWindow}

Procedure CloseAllWindows;
Begin
While CurrentScreen^.BackLink <> nil do
  CloseWindow;
End; {CloseAllWindows}

Procedure TerminateScreens;
Begin
Dispose(CurrentScreen);
Dispose(WorkScreen);
End; {TerminateScreens}

{*******************************************************************}
{** End of windowing routines **}{** Start of data entry routines **}
{*******************************************************************}

Procedure MaxLimits;
Begin
LowerByte := 0;         UpperByte := 255;
LowerInt  := -32767;    UpperInt  := MaxInt;
LowerReal := 1E-38;     UpperReal := 1E+37;
End; {MaxLimits}

Function EnterData(Var Variable;                { Variable being entered  }
                         VarTyp     : Char;     { Indicated Variable type }
                         XLoc,YLoc,             { X & Y Co-ordinates      }
                         Len,                   { Length of field         }
                         Decs,                  { No. of decimal places   }
                         FieldAttr,
                         CursorAttr : Byte;
                         Exits      : ExitsTyp):Integer; {Exits in addition to }
Type                                                     { -1 : Param error    }
  Edits = Set of Char;                                   {  0 : Typing out     }
                                                         { 13 : Carriage Return}
                                                         {-13 : ^M             }
Const
  BytIntEdits : Edits = ['0'..'9','+','-',' '];        {Pre-defined edit types}
  RealEdits   : Edits = ['0'..'9','+','-','.','E',' '];
  StrEditsAll : Edits = [' '..'}'];
  Alpha       : Edits = ['A'..'Z','a'..'z',' '];
  UpperCase   : Edits = ['A'..'Z',' '];
  LowerCase   : Edits = ['a'..'z',' '];
  Numeric     : Edits = ['0'..'9'];
  Date        : Edits = ['0'..'9','/'];
  ClickOn     : Boolean = False;
  InsertOn    : Boolean = False;

Var
  BytVar     : Byte     absolute Variable;
  IntVar     : Integer  absolute Variable;
  RealVar    : Real     absolute Variable;
  StrgVar    : Str80    absolute Variable;
  WorkStr    : Str80;
  OrigStr    : Str80;
  ValidChars : Edits;
  Done       : Boolean;
  Converted  : Boolean;
  CtrlEmm    : Boolean;
  CharIn     : Char;
  Position   : Byte;

Procedure Beep;
Begin
Sound(800);
Delay(50);
Nosound;
End; {Beep}

Procedure MakeClickNoise;
Begin
Sound(2000);
Delay(5);
NoSound;
End; {ClickNoise}

Procedure RefreshDisplay;
Var
  TempStr   : Str80;
  WrkLen,I  : Integer;

Procedure RefreshRite(S:Str80;X,Y:Byte);
Var
  I,Attr  : Integer;
Begin
For I := 1 to Length(S) do
  Begin
  Attr := FieldAttr shl 8;
  If (I = Position) and (not Converted) then
    Attr := CursorAttr shl 8;
  MemW[Seg(PhysicalScreen^):(Y-1)*160+(X+I-2)*2] := Attr or Ord(S[I]);
  End;
End; {RefreshRite}

Begin
TempStr := WorkStr;
For I := Length(WorkStr) + 1 to Len do
  TempStr := Concat(TempStr,#95);
RefreshRite(TempStr,XLoc,YLoc);
End; {RefreshDisplay}

Procedure QueryExits;
Var
  StatusByte : Byte;
Begin
If CharIn = #13 then                { CR always exits }
  Begin
  Done      := True;
  EnterData := 13;
  With SG_Registers do
    Begin
    AX := 2 shl 8;
    Intr($16,SG_Registers);
    StatusByte := Lo(AX);
    If (StatusByte and $04 > 0) then
      Begin
      EnterData := -13;
      CtrlEmm   := True;
      End;
    End
  End
Else
  If (Ord(CharIn) in Exits) then
    Begin
    Done      := True;
    EnterData := Ord(CharIn);
    End
  Else
    Begin
    Beep;
    CharIn := #255;
    End;
End;

Procedure CursorRight;
Var
  NewPos : Byte;
Begin
If ((Position = Len) and (Length(WorkStr) = Len)) then
  Begin
  Beep;
  Exit;
  End;
NewPos := Position + 1;
If NewPos <= (Length(WorkStr)+1) then
  Position := NewPos
Else
  Beep;
End; {CursorRight}

Procedure CursorLeft;
Var
  NewPos : Byte;
Begin
NewPos := Position - 1;
If NewPos >= 1 then
  Position := NewPos
Else
  Beep;
End; {CursorLeft}

Procedure JumpRightWord;
Var
  I,WrkLen : Integer;
Begin
WrkLen := Length(WorkStr);
If (not (VarTyp in ['B','I','R'])) then
  If (Position < WrkLen) then
    Begin
    I := Position;
    If (WorkStr[I] <> ' ') then
      While ((I < WrkLen) and (WorkStr[I] <> ' ')) do
        I := I + 1;
    While ((I < WrkLen) and (WorkStr[I] = ' ')) do
      I := I + 1;
    Position := I;
    End
  Else
    Beep
Else
  Beep;
End; {JumpRightWord}

Procedure JumpLeftWord;
Var
  I,WrkLen : Integer;
Begin
If (not (VarTyp in ['B','I','R'])) then
  If (Position > 1) then
    Begin
    I := Position - 1;
    If (WorkStr[I] = ' ') then
      While ((I > 1) and (WorkStr[I] = ' ')) do
        I := I -1;
    While (I > 1) and (WorkStr[I] <> ' ') do
      I := I - 1;
    Position := I;
    If (I > 1) then
      Position := I + 1;
    End
Else
  Beep;
End; {JumpLeftWord}

Procedure JumpRightField;
Begin
If Length(WorkStr) = Len then
  If Position = Len then
    Beep
  Else
    Position := Len
Else
  If Position = Length(WorkStr) + 1 then
    Beep
  Else
    Position := Length(WorkStr) + 1;
End;

Procedure RightJustify;
Var
  StatusByte : Byte;
Begin
With SG_Registers do
  Begin
  AX := 2 shl 8;
  Intr($16,SG_Registers);
  StatusByte := Lo(AX);
  If (StatusByte and $04 > 0) then
    Begin
    QueryExits;
    Exit;
    End;
  End;
If (VarTyp in ['B','I','R']) then
  Beep
Else
  If (Length(WorkStr) < Len) then
    Begin
    Position := 1;
    While WorkStr[Length(WorkStr)] = ' ' do
      Delete(WorkStr,Length(WorkStr),1);
    While Length(WorkStr) < Len do
      Begin
      WorkStr  := Concat(' ',WorkStr);
      Position := Position + 1;
      End;
    End;
End; {RightJustify}

Procedure LeftJustify;
Begin
If (VarTyp in ['B','I','R']) then
  Beep
Else
  Begin
  While WorkStr[1] = ' ' do
    Delete(WorkStr,1,1);
  Position := 1;
  End;
End; {LeftJustify}

Procedure Change2UpperCase;
Var
  I : Integer;
Begin
If not (VarTyp in ['S','A']) then
  Beep
Else
  For I := 1 to Length(WorkStr) do
    If WorkStr[I] in ['a'..'z'] then
      WorkStr[I] := Chr(Ord(WorkStr[I])-32);
End; {Change2UpperCase}

Procedure Change2LowerCase;
Var
  I : Integer;
Begin
If not (VarTyp in ['S','A']) then
  Beep
Else
  For I := 1 to Length(WorkStr) do
    If WorkStr[I] in ['A'..'Z'] then
      WorkStr[I] := Chr(Ord(WorkStr[I])+32);
End; {Change2LowerCase}

Procedure AddACharacter;
Var
  NewPos : Integer;
Begin
If Position < Len then
  NewPos := Position + 1
Else
  If Length(WorkStr) <> Len then
    NewPos := Position
  Else
   Begin
   Beep;
   Exit;
   End;
If NewPos <= Len then
  Begin
  WorkStr  := Concat(WorkStr,CharIn);
  If Position < Len then
    Position := Position + 1;
  If (VarTyp in ['S','A','U','L','N','D'])  and
     (Length(WorkStr) = Len)  then
       Begin
       Done      := True;
       EnterData := 0;
       End;
  End;
End; {AddACharacter}

Procedure ChangeACharacter;
Begin
WorkStr[Position] := CharIn;
If (Position < Len) then
  Position := Position + 1;
End;

Procedure InsertACharacter;
Begin
If (Length(WorkStr) + 1) <= Len then
  Begin
  Insert(CharIn,WorkStr,Position);
  Position := Position + 1;
  End
Else
  Beep;
End; {InsertACharacter}

Procedure DeleteACharacter;
Begin
If Length(WorkStr) > 0 then
  Delete(WorkStr,Position,1)
Else
  Beep;
End; {DeleteACharacter}

Procedure DestructiveBackspace;
Begin
If (Length(WorkStr) > 0)  and
   (Position > 1)         then
  Begin
  Position := Position - 1;
  Delete(WorkStr,Position,1);
  End
Else
  Beep;
End;

Function Initialized : Boolean;
Begin
Initialized := False;
If VarTyp in ['B','I','R'] then
  Begin
  Case VarTyp of
    'B' : Str(BytVar,WorkStr);
    'I' : Str(IntVar,WorkStr);
    'R' : Begin
          Str(RealVar:Len:Decs,WorkStr);
          While WorkStr[1] = ' ' do
            Delete(WorkStr,1,1);
          End;
    End;
  If Length(WorkStr) <= Len then
    Begin
    Initialized := True;
    OrigStr     := WorkStr;
    RefreshDisplay;
    End;
  End
Else
  If VarTyp in ['S','A','U','L','N','D'] then
    Begin
    WorkStr     := StrgVar;
    Initialized := True;
    OrigStr     := WorkStr;
    RefreshDisplay;
    End;
End; {Initialized}

Procedure AssignValues;
Var
  RetnCode,WrkLen,TempInt  : Integer;
  TempReal                 : Real;
  ConvertStr               : Str80;

Function Clean(NumericString:Str80):Str80;
Begin
While (Length(NumericString) > 0) and
      (NumericString[1] = ' ') do
  Delete(NumericString,1,1);
While (Length(NumericString) > 0) and
      (NumericString[Length(NumericString)] = ' ') do
  Delete(NumericString,Length(NumericString),1);
If (Length(NumericString) = 0) then
  NumericString := ' ';
Clean := NumericString;
End; {Clean}

Procedure NumericFormat;
Var
  I,PLoc : Integer;
Begin
ConvertStr := Clean(ConvertStr);
If (Pos('E',ConvertStr) > 0) then
  Begin
  While (Length(ConvertStr) < Len) do
    ConvertStr := Concat(' ',ConvertStr);
  WorkStr := ConvertStr;
  RefreshDisplay;
  Exit;
  End;
PLoc := Pos('.',ConvertStr);
If PLoc = 0 then
  I := Length(ConvertStr) + 1
Else
  I := PLoc;
While I > 1 do
  Begin
  I := I - 3;
  If I > 1 then
    Insert(',',ConvertStr,I);
  End;
If Length(ConvertStr) <= Len then
  Begin
  While Length(ConvertStr) < Len do
    ConvertStr := Concat(' ',ConvertStr);
  WorkStr := ConvertStr;
  RefreshDisplay;
  End
Else
  Begin
  While Length(WorkStr) < Len do
    WorkStr := Concat(' ',WorkStr);
  RefreshDisplay;
  End;
End; {NumericFormat}

Begin
If ((Ord(CharIn) in Exits) or CtrlEmm) then
  Begin
  Converted := True;
  WorkStr   := OrigStr;
  RefreshDisplay;
  Exit;
  End;
If VarTyp in ['B','I','R'] then
  Begin
  ConvertStr := WorkStr;
  Case VarTyp of
    'B' : Val(Clean(ConvertStr),TempInt,RetnCode);
    'I' : Val(Clean(ConvertStr),TempInt,RetnCode);
    'R' : Val(Clean(ConvertStr),TempReal,RetnCode);
    End; {case}
  If RetnCode = 0 then
    Begin
    Case VarTyp of
      'B' : If (TempInt >= LowerByte) and (TempInt <= UpperByte) then
              Begin
              BytVar    := TempInt;
              Converted := True;
              End;
      'I' : If (TempInt >= LowerInt) and (TempInt <= UpperInt) then
              Begin
              IntVar    := TempInt;
              Converted := True;
              End;
      'R' : If (TempReal >= LowerReal) and (TempReal <= UpperReal) then
              Begin
              RealVar   := TempReal;
              Converted := True;
              End;
      End; {case}
    If Converted then
      NumericFormat
    Else
      Begin
      Done     := False;
      Position := 1;
      RefreshDisplay;
      Beep;
      End;
    End
  Else
    Begin
    Done     := False;
    Position := RetnCode;
    RefreshDisplay;
    Beep;
    End;
  End
Else
  Begin
  StrgVar   := WorkStr;
  Converted := True;
  RefreshDisplay;
  End;
End; {AssignValues}

Begin
Done      := False;
Converted := False;
CtrlEmm   := False;
Position  := 1;
Case VarTyp of
  'B','I'
      : ValidChars := BytIntEdits;
  'R' : ValidChars := RealEdits;
  'S' : ValidChars := StrEditsAll;
  'A' : ValidChars := Alpha;
  'U' : ValidChars := UpperCase;
  'L' : ValidChars := LowerCase;
  'N' : ValidChars := Numeric;
  'D' : ValidChars := Date;
Else
  Begin
  EnterData := -1;
  Exit;
  End;
End; {case}
If Len > 78 then
  Begin
  EnterData := -1;
  Exit;
  End;
With LastOpened do
  Begin
  XLoc := XLoc + X1;
  YLoc := YLoc + Y1;
  End;
If not Initialized then
  Begin
  EnterData := -1;
  Exit;
  End;
Repeat  {Data Conversion Loop}
  Repeat  {Data Entry Loop}
    Reset(kbd);
    Read(kbd,CharIn);
    If ClickOn then
      MakeClickNoise;
    If (CharIn = #27) and KeyPressed then
      Begin
      Read(kbd,CharIn); { If you are processing an extended scan code, then }
      Case CharIn of          { translate is as a commands }
        #77 : CharIn := ^D;      { Unshft RArr }
        #75 : CharIn := ^S;      { Unshft LArr }
        #116: CharIn := ^F;      { Ctrl'd RArr }
        #115: CharIn := ^A;      { Ctrl'd LArr }
        #82,#165
            : CharIn := ^V;      { Ins : Unshft, Ctrl'd }
        #83,#166
            : CharIn := ^G;      { Del : Unshft, Ctrl'd }
        #71 : Begin
              If Position = 1 then
                Beep
              Else
                Position := 1;
              CharIn := #255;
              End;
        #79 : Begin              { UnShft End }
              JumpRightField;
              CharIn := #255;
              End;
        #15 : Begin
              LeftJustify;
              CharIn := #255;
              End;
                              { or process it as an exit - delete unused exits }
        #59..#68,  #84..#93,
        #94..#103, #104..#113    { All function keys }
            : QueryExits;
        #119,                    { Ctrl'd Home }
        #117,                    { End  : Ctrl'd }
        #73,#132,                { PgUp : Unshft, Ctrl'd }
        #81,#118                 { PgDn : Unshft, Ctrl'd }
            : QueryExits;
        #72,#80                  { UArr, DArr : Unshft }
            : QueryExits;
        #3,#114,                 { Ctrl'd 2, Ctrl'd * }
        #120..#131               { Alt'd 1..9,0,-,= }
            : QueryExits;
        #30,#48,#46,#32,#18,#33,#34,#35,#23,#36,#37,#38,#50,
        #49,#24,#25,#16,#19,#31,#20,#22,#47,#17,#45,#21,#44
            : QueryExits;        { Alt'd alphabetica, A..Z }
      Else                    { or declare it to be invalid. }
              CharIn := #00;
        End; {case}
      End;

    If CharIn in [#27,#13,#10] then  { other exits }
      QueryExits;

    If not Done then      { If an exit has not been entered, }
      Begin
      Case VarTyp of
        'U' : If CharIn in ['a'..'z'] then
                CharIn := Chr(Ord(CharIn)-32);
        'L' : If CharIn in ['A'..'Z'] then
                CharIn := Chr(Ord(CharIn)+32);
        End;
      Case CharIn of                { Process CharIn as a command  }
        ^D : CursorRight;
        ^S : CursorLeft;
        ^A : JumpLeftWord;
        ^F : JumpRightWord;
       #09 : RightJustify;          { Tab = #15 = ^I }
        ^G : DeleteACharacter;
        ^H,#127
           : DestructiveBackspace;
        ^B : ClickOn  := not ClickOn;
        ^U : Change2UpperCase;
        ^L : Change2LowerCase;
        ^V : InsertOn := not InsertOn;
        ^E : WorkStr  := Copy(WorkStr,1,(Position-1));
        ^X : Begin
             WorkStr  := '';
             Position := 1;
             End;
        ^C,^K,^N,^O,^P,^Q,^R,^T,^W,^Y,^Z
           : QueryExits;
      Else                    { or as a normal character. }
        If (not (CharIn in ValidChars)) then
          If (CharIn <> #255) then
            Beep
          Else
        Else
          If InsertOn then
            If Position <= Length(WorkStr) then
              InsertACharacter
            Else
              AddACharacter
          Else
            If Position <= Length(WorkStr) then
              ChangeACharacter
            Else
              AddACharacter;
      End; {case}
    RefreshDisplay;
    End;
  Until Done;
AssignValues;
Until Converted;
End; {EnterData}

Type
  Str255 = String[255];

Procedure Rite(S:Str80;X,Y:Byte;Attr:Integer);
Var
  I,Loc  : Integer;
Begin
Attr := Attr shl 8;
For I := 1 to Length(S) do
  MemW[Seg(PhysicalScreen^):(Y-1)*160+(X+I-2)*2] := Attr or Ord(S[I]);
End; {Rite}

Procedure WinRite(S:Str80;X,Y:Byte;Attr:Integer);
Begin
With LastOpened do
  Begin
  X := X + X1;
  Y := Y + Y1;
  End;
Rite(S,X,Y,Attr);
End; {WinRite}

Function Menu(Window  : Byte;
                   S  : Str255;
          Selections,NormAttr,ReverseAttr
                      : Byte;
               Exits  : ExitsTyp) : Byte;
Var
  I,XLoc,YLoc,Block,Width : Integer;
                       Ch : Char;

Procedure WriteSelections(XLoc,YLoc:Byte);
Var
  InitialAttr : Byte;
Begin
For I := 1 to Selections do
  Begin
  InitialAttr := NormAttr;
  If I = 1 then
    InitialAttr := ReverseAttr;
  Rite(Copy(S,1,(Pos('\',S)-1)),XLoc,(YLoc+I-1),InitialAttr);
  Delete(S,1,Pos('\',S));
  End;
End; {WriteSelections}

Procedure ReverseBG(X,Y:Byte;Attr:Integer);
Var
  Loc : Integer;
Begin
Attr := Attr shl 8;
For I := 1 to Width do
  Begin
  Loc := (Y-1)*160+(X+I-2)*2;
  MemW[Seg(PhysicalScreen^):Loc] := Attr or Lo(MemW[Seg(PhysicalScreen^):Loc]);
  End;
End; {ReverseBG}

Procedure MakeSelections;
Begin
Block := 1;
Repeat
  Read(kbd,Ch);
  If KeyPressed then
    Begin
    Read(kbd,Ch);
    If (Ord(Ch) = 72) and (Block > 1) then
      Begin                                      { 72 : Unshft Up Arrow }
      ReverseBg(XLoc,(YLoc+Block-1),NormAttr);
      Block := Block - 1;
      ReverseBG(XLoc,(YLoc+Block-1),ReverseAttr);
      End
    Else
      If (Ord(Ch) = 80) and (Block < (Selections)) then
        Begin                                    { 80 : Unshft Down Arrow }
        ReverseBg(XLoc,(YLoc+Block-1),NormAttr);
        Block := Block + 1;
        ReverseBG(XLoc,(YLoc+Block-1),ReverseAttr);
        End;
    End;
Until (Ord(Ch) in [13,27]) or (Ord(Ch) in Exits);
If Ord(Ch) = 27 then
  Menu := 0
Else
  If Ord(Ch) in Exits then
    Menu := Ord(Ch)
  Else
    Menu := Block;
End; {MakeSelections}

Begin
OpenWindow(Window);
With LastOpened do
  Begin
  XLoc  := X1 + 1;
  YLoc  := Y1 + 1;
  Width := X2 - X1 -1;
  End;
WriteSelections(XLoc,YLoc);
MakeSelections;
CloseWindow;
End; {Menu}

{** End of MGPROG.INC **}{**********************************************}