Simtel MSDOS 1992 September/Simtel20_Sept92.cdr/msdos/turbopas/pull15.arc/PULL15.INC

Text File | 1987-08-31 | 25.1 KB | 856 lines

{ Pull15.inc - Turbo Pascal full featured pull-down menus.  ver 1.5, 08-31-87 }
{ (c) 1987 James H. LeMay                                                     }

type
  LineModeType   = (Choice, ExecOnly, Comment, Partition,
                    ToDataWndw, ToSubMenu, ToUserWndw);
  MenuModeType   = (ExecChoice, ExecSingleChoice, ExecMultipleChoice,
                    SingleChoice, MultipleChoice);
  TypeOfDataType = (Bytes,Integers,Reals,UserNums,Chars,Strings,UserStrings);
  Toggle         = (Off, On, No, Yes);
  MaxString      = string[MaxStringLength];
  ErrMsgString   = string[MaxErrStrLength];
  MenuRec = record
              Title:        string[MaxCharsPerLine];
              CmdLtrs:      string[MaxMenuLines];
              Line:         array[1..MaxMenuLines] of string[MaxCharsPerLine];
              LineMode:     array[1..MaxMenuLines] of LineModeType;
              Flagged:      array[1..MaxMenuLines] of boolean;
              LinkNum:      array[1..MaxMenuLines] of byte;
              LinkDir:      DirType;
              MenuMode:     MenuModeType;
              MenuLines:    byte;
              NameCol:      byte;
              Row, Col, Rows, Cols:                    byte;
              DefaultLine, HiLiteLine, SingleFlagLine: byte;
              Battr, Wattr, Hattr, Lattr, Cattr:       byte;
              Border:                                  Borders;
              BackToDefault, Changed:                  boolean;
              MsgLineNum, HelpWndwNum:                 byte
            end;
  DataWndwRec = record
              Line: array[1..2] of string[MaxCharsPerLine];
              TypeOfData:               TypeOfDataType;
              Row, Col, Rows, Cols:     byte;
              RowAlt, ColAlt:           byte;
              FirstCol, Field:          byte;
              Decimals:                 integer;
              Justify:                  DirType;
              Battr, Wattr, Hattr:      byte;
              Border:                   Borders;
              MsgLineNum, HelpWndwNum:  byte;
            end;
  HelpWndwRec = record
              FirstLine, LastLine:      byte;
              LinesToShow:              byte;
              Row, Col, Rows, Cols:     byte;
              Battr, Wattr:             byte;
              Border:                   Borders;
              Zoom:                     boolean;
              Shadow:                   DirType;
              MsgLineNum:               byte
            end;

const
  HelpKey = #59;    { F1 }   { Set equal to #00 if Help access is not wanted. }
  PopKey  = #60;    { F2 }
  TopKey1 = #68;    { F10 }  { Extended function key }
  TopKey2 = #47;    { '/' }
  EscKey  = #27;    { ^[ }
  RetKey  = #13;    { ^M }
  HideCursor = $2000;        { CursorMode to hide the cursor. }

var
  MainMenu: array[1..NumOfMainMenus] of MenuRec;
  SubMenu:  array[1..NumOfSubMenus]  of MenuRec;
  DataWndw: array[1..NumOfDataWndws] of DataWndwRec;
  HelpWndw: array[1..NumOfHelpWndws] of HelpWndwRec;
  HelpLine: array[1..TotalHelpLines] of string[HelpCharsPerLine];
  MsgLine:  array[1..NumOfMsgLines]  of MaxString;
  ErrMsgLine:   array[1..NumOfErrMsgLines] of ErrMsgString;
  TempMsgArray: array[1..512] of byte;

  TopMenuRow,    MainMenuRow,
  InitAttr,      StatusAttr,
  TopMenuAttr,   TopMenuHattr,  TopMenuLattr,  MsgLineAttr,
  MainMenuWattr, MainMenuBattr, MainMenuHattr, MainMenuLattr, MainMenuCattr,
  SubMenuWattr,  SubMenuBattr,  SubMenuHattr,  SubMenuLattr,  SubMenuCattr,
  HelpWndwWattr, HelpWndwBattr: byte;
  MainMenuBrdr,  SubMenuBrdr,  HelpWndwBrdr: Borders;
  HelpShadow:    DirType;
  HelpZoom:      boolean;
  HelpMsgLineNum:integer;
  TopCmdLtrs:    string[NumOfMainMenus];
  CmdSeq,MoreCmdSeq: string[MaxWndw];
  RowsBelowHelp,RowsBelowMsg: byte;

  CRTcols, CRTrows: integer;

  MPulled, SPulled, HiLited,i,j:      integer;
  OldMPulled, OldSPulled, OldHiLited: integer;
  TopMenuStr:       MaxString;
  ExtKey, Quit:     boolean;
  LocationWarning:  boolean;
  Key:              char;

  Pull, Pop:        boolean;
  PopLevels:        byte;
  PopToWorkWndw, PopToTop, PopAndProcess, InWorkWndw: boolean;
  WorkWndwStep:     integer;

{ These are forward for access outside of PULL15.INC. }
procedure Process (MPulled,SPulled,HiLited: integer);         forward;
procedure GetUserPullStats;                                   forward;
procedure GetOverrideStats;                                   forward;
procedure WorkWndw;                                           forward;
procedure PullDataWndw (VAR Menu: MenuRec; WndwNum: integer); forward;
procedure InitDataWndwSize;                                   forward;
procedure InitDataWndwColor;                                  forward;
procedure PullUserWndw (VAR Menu: MenuRec; WndwNum: integer); forward;

procedure ReadKB (VAR ExtKey: boolean; VAR Key: char);
begin
  Read (Kbd,Key);                        { Read keyboard input.      }
  if KeyPressed and (Key=EscKey) then    { If first Char was ESC ... }
    begin
      Read (Kbd,Key);                    { ... read second char.     }
      ExtKey := true
    end
  else ExtKey:=false;
end;

procedure ShowMsg (MsgNum: integer);
begin
    QwriteV (CRTrows-RowsBelowMsg,1,MsgLineAttr,MsgLine[MsgNum])
end;

procedure HiLiteLetter (VAR Menu: MenuRec; HLine: integer);
begin
  with Menu do
    Qattr (Row+HLine,Col+3+pos(CmdLtrs[HLine],Line[HLine]),1,1,Lattr);
end;

procedure MoveHiLite (VAR Menu: MenuRec; HLnew: integer);
begin
  with Menu do
    if HLnew<>HiLiteLine then
      begin
        Qattr (Row+HiLiteLine,succ(Col),1,Cols-2,Wattr);
        HiLiteLetter (Menu,HiLiteLine);
        Qattr (Row+HLnew,succ(Col),1,Cols-2,Hattr);
        HiLiteLine:=HLnew;
      end;
end;

procedure ShowMenu (VAR Menu: MenuRec);
var
  R,C,Attrib:   integer;
  Symbol:       string[1];
  PartitionStr: string[3];
begin
  with Menu do
  begin
    MakeWindow (Row,Col,Rows,Cols,Wattr,Battr,Border);
    for i:=1 to MenuLines do
      begin
        R:=Row+i;
        if LineMode[i]=Partition then
          begin
            case LinkNum[i] of
              11: PartitionStr:='├─┤';
              12: PartitionStr:='╞═╡';
              21: PartitionStr:='╟─╢';
              22: PartitionStr:='╠═╣';
            else with Brdr[Border] do PartitionStr:=LV+BH+RV;
            end;  { case }
            Qwrite (R,Col,                  -1,PartitionStr[1]);
            Qwrite (R,pred(Col)+Cols,       -1,PartitionStr[3]);
            Qfill  (R,succ(Col),1,Cols-2,Battr,PartitionStr[2])
          end
        else
          begin
            if LineMode[i]=Comment then
                 Attrib:=Cattr
            else Attrib:=-1;
            if Flagged[i] then Qwrite (R,Col+2,Attrib,#16);
            QwriteV (R,Col+4,Attrib,Line[i]);
            if LineMode[i]<>Comment then HiLiteLetter(Menu,i);
            case LineMode[i] of ToDataWndw..ToUserWndw:
              begin
                if LinkDir=Left then
                     C:=succ(Col)
                else C:=Col+Cols-2;
                if LineMode[i]=ToDataWndw then
                     Symbol:=#250
                else Symbol:=#240;
                QwriteV (R,C,-1,Symbol);
              end;
            end   { case }
          end
      end;   { for i }
    if BackToDefault then HiLiteLine:=DefaultLine;
    Qattr (Row+HiLiteLine,succ(Col),1,Cols-2,Hattr);
  end
end;

procedure RollHiLite (VAR Menu: MenuRec; Dir: DirType);
var HLnew: integer;
begin
  with Menu do
  begin
    HLnew:=HiLiteLine;
    repeat
      case Dir of
        Up:     if HLnew=1 then
                     HLnew:=MenuLines
                else HLnew:=pred(HLnew);
        Down:   if HLnew=MenuLines then
                     HLnew:=1
                else HLnew:=succ(HLnew);
        Top:    begin
                  HLnew:=1;
                  Dir:=Down
                end;
        Bottom: begin
                  HLnew:=MenuLines;
                  Dir:=Up
                end;
      end;  { case }
    until (LineMode[HLnew]<>Comment) and (LineMode[HLnew]<>Partition);
    MoveHiLite (Menu,HLnew);
  end
end;

procedure ShowTopMenu;
begin
  QwriteV (TopMenuRow,1,TopMenuAttr,TopMenuStr);
  for i:=1 to LastMainMenu do
    Qattr (TopMenuRow,succ(MainMenu[i].NameCol),1,1,TopMenuLattr);
end;

procedure ShowTopHiLite;
begin
  with MainMenu[MPulled] do
    Qattr (TopMenuRow,NameCol,1,ord(Title[0])+2,TopMenuHattr);
end;

procedure MoveTopHiLite (MPnew: integer);
begin
  if MPnew<>MPulled then
    begin
      MPulled:=MPnew;
      ShowTopMenu;
      ShowTopHiLite;
    end;
end;

procedure RollMenu (Dir: DirType);
var MPnew: integer;
begin
  MPnew:=MPulled;
  case Dir of
    Left:     if MPnew=1 then
                   MPnew:=LastMainMenu
              else MPnew:=pred(MPnew);
    Right:    if MPnew=LastMainMenu then
                   MPnew:=1
              else MPnew:=succ(MPnew);
    FarLeft:  MPnew:=1;
    FarRight: MPnew:=LastMainMenu;
  end;
  if MPnew<>MPulled then
    begin
      RemoveWindow;
      MoveTopHiLite (MPnew);
      ShowMenu (MainMenu[MPulled]);
      ShowMsg (MainMenu[MPulled].MsgLineNum);
      CmdSeq:=TopCmdLtrs[MPulled];
    end;
end;

procedure DoChoice (VAR Menu: MenuRec; VAR TF: boolean);
type  Str1 = string[1];
var   Flag: Str1;
{}procedure ShowFlag (LineNum: integer; Flag: Str1);
  begin
    with Menu do
      QwriteV (Row+LineNum,Col+2,-1,Flag)
{}end;
begin
  with Menu do
    begin
      if MenuMode<=ExecMultipleChoice then
        Process (MPulled,SPulled,HiLited);
      case MenuMode of
        SingleChoice,ExecSingleChoice:
          if TF=false then
            begin
              Flagged[SingleFlagLine] := false;
              TF := true;
              ShowFlag (SingleFlagLine,' ');
              SingleFlagLine := HiLited;
              ShowFlag (HiLited,^P);
              Changed := true;
            end;
        MultipleChoice,ExecMultipleChoice:
          begin
            TF := TF xor true;
            if TF then
                 Flag:=^P
            else Flag:=' ';
            ShowFlag (HiLited,Flag);
            Changed := true;
          end;
      end; { case }
  end    { with }
end;

{$V-}
procedure TempMsg (Switch: Toggle; VAR Msg: MaxString);
var Row,L: integer;
begin
  Row := CRTrows-RowsBelowMsg;
  case Switch of
    On: begin
          QstoreToMem (Row,1,1,MaxStringLength shl 1,TempMsgArray);
          QwriteV (Row,1,MsgLineAttr,Msg);
          L := length (Msg);
          Qfill (Row,succ(L),1,CRTcols-L,-1,' ');
        end;
    Off:  QstoreToScr (Row,1,1,MaxStringLength shl 1,TempMsgArray);
  end
end;

procedure ShowErrorMsg (ErrMsgNum: integer);
var Row,L: integer;
begin
  TempMsg (On,ErrMsgLine[ErrMsgNum]);
  repeat
    sound (100);
    delay (30);
    nosound;
    ReadKB (ExtKey,Key);
  until Key=EscKey;
  Key:=' ';
  TempMsg (Off,ErrMsgLine[1]);
end;
{$V+}

function TopKeyPressed: boolean;
begin
  if (ExtKey and (Key=TopKey1)) or (not ExtKey and (Key=TopKey2)) then
       TopKeyPressed:=true
  else TopKeyPressed:=false
end;

function HelpKeyPressed: boolean;
begin
  if ExtKey and (Key=HelpKey) then
       HelpKeyPressed:=true
  else HelpKeyPressed:=false  { F1 key }
end;

procedure PullHelpWndw (WndwNum: integer; Title: MaxString);
var  OldCursor: integer;
begin
  CursorChange (HideCursor,OldCursor);
  with HelpWndw[WndwNum] do
    begin
      ZoomEffect:=HelpZoom;
      ShadowEffect:=HelpShadow;
      TempMsg (On,MsgLine[MsgLineNum]);
      MakeWindow (Row,Col,Rows,Cols,Wattr,Battr,Border);
      if Title<>'' then
        TitleWindow (Center,' Help for "'+Title+'" ');
      for i:=FirstLine to pred(FirstLine+LinesToShow) do
        QwriteV (succ(Row)+i-FirstLine,Col+2,-1,HelpLine[i]);
    end;
  repeat
    ReadKB (ExtKey,Key);
    if HelpKeyPressed then Key:=EscKey;   { Help key -> ESC key }
  until Key=EscKey;
  Key:=' ';
  RemoveWindow;
  ZoomEffect:=false;
  ShadowEffect:=NoDir;
  TempMsg (Off,MsgLine[1]);
  CursorChange (OldCursor,OldCursor);
end;

procedure TurnArrows (Switch: Toggle; VAR Menu: MenuRec);
var Arrow: string[1];
    R: integer;
begin
  with Menu do
    begin
      R:=Row+HiLiteLine;
      if Switch=Off then Arrow:=' '
      else
        case LinkDir of
          Left:  Arrow:='<';
          Right: Arrow:='>';
        end;
      QwriteV (R,Col+2     ,-1,Arrow);
      QwriteV (R,Col+Cols-3,-1,Arrow);
    end
end;

procedure CheckForPull;
begin
  if Pull then
    begin
      if MoreCmdSeq='' then Pull:=false
      else
        begin
          Key:=MoreCmdSeq[1];
          MoreCmdSeq[0]:=pred(MoreCmdSeq[0]);
          { Delete the first character }
          Move (MoreCmdSeq[2],MoreCmdSeq[1],ord(MoreCmdSeq[0]));
        end;
      ExtKey:=false
    end
end;

procedure CheckForPop;
begin
  if PopToWorkWndw and not Pop then MoreCmdSeq:=CmdSeq;
  if PopToWorkWndw or PopToTop or (PopLevels>0) then
       Pop:=true
  else Pop:=false;
  if PopLevels>0 then PopLevels:=pred(PopLevels)
end;

function Popped: boolean;
begin
  if InWorkWndw then Popped:=true
  else
    begin
      OldMPulled:=MPulled;
      OldSPulled:=SPulled;
      OldHiLited:=HiLited;
      PopToWorkWndw:=true;
      PopAndProcess:=true;
      Popped:=false
    end
end;

procedure PullSubMenu (VAR Menu: MenuRec; MenuNum: integer); forward;

procedure CheckSelection (VAR Menu: MenuRec);
var Position: integer;
begin
  if TopKeyPressed then PopToTop:=true
  else
  with Menu do
  begin
    Position := pos (upcase(Key),CmdLtrs);
    if Position<>0 then
      begin
        MoveHiLite(Menu,Position);
        Key:=RetKey
      end;
    if Key=RetKey then
      begin
        HiLited:=HiLiteLine;
        case LineMode[HiLited] of
          Choice:     DoChoice     (Menu,Flagged[HiLited]);
          ExecOnly:   Process      (MPulled,Spulled,HiLited);
          ToDataWndw: PullDataWndw (Menu,LinkNum[HiLited]);
          ToSubMenu:  PullSubMenu  (Menu,LinkNum[HiLited]);
          ToUserWndw: PullUserWndw (Menu,LinkNum[HiLited]);
        end
      end
  end  { with }
end;

procedure PullSubMenu;  { (VAR Menu: MenuRec; MenuNum: integer) }
begin
  SPulled:=MenuNum;
  with Menu do
    CmdSeq:=CmdSeq+CmdLtrs[HiLiteLine];
  TurnArrows (On,Menu);
  ShowMenu (SubMenu[MenuNum]);
  repeat
    with SubMenu[MenuNum] do
    begin
      CheckForPull;
      if not Pull then
        begin
          ShowMsg (MsgLineNum);
          ReadKB (ExtKey,Key)
        end;
      if ExtKey then
        case Key of
          #72:     RollHiLite (SubMenu[MenuNum],Up    );  { Up   arrow }
          #80:     RollHiLite (SubMenu[MenuNum],Down  );  { Down arrow }
          #71,#73: RollHiLite (SubMenu[MenuNum],Top   );  { Home and PgUp }
          #79,#81: RollHiLite (SubMenu[MenuNum],Bottom);  { End  and PgDn }
          HelpKey: PullHelpWndw (HelpWndwNum,Title);      { F1 }
          PopKey:  PopToWorkWndw:=true;                   { F2 }
          TopKey1: PopToTop:=true;                        { F10 }
        end      { end case }
      else  CheckSelection (SubMenu[MenuNum]);
      CheckForPop
    end;  { with }
  until (Key=EscKey) or Pop;
  Key:=' ';
  RemoveWindow;
  CmdSeq[0]:=pred(CmdSeq[0]);
  TurnArrows (Off,Menu);
  if not Pop then ShowMsg (Menu.MsgLineNum)
end;

procedure PullMainMenu;
begin
  SPulled:=0;
  CmdSeq:=TopCmdLtrs[MPulled];
  ShowMenu (MainMenu[MPulled]);
  repeat
    with MainMenu[MPulled] do
    begin
      CheckForPull;
      if not Pull then
        begin
          ShowMsg (MsgLineNum);
          ReadKB (ExtKey,Key)
        end;
      if ExtKey then
        case Key of
          #72:      RollHiLite (MainMenu[MPulled],Up      );  { Up   arrow }
          #80:      RollHiLite (MainMenu[MPulled],Down    );  { Down arrow }
          #71,#73:  RollHiLite (MainMenu[MPulled],Top     );  { Home & PgUp }
          #79,#81:  RollHiLite (MainMenu[MPulled],Bottom  );  { End  & PgDn }
          #75:      RollMenu   (                  Left    );  { Left  arrow }
          #77:      RollMenu   (                  Right   );  { Right arrow }
          #119,#115:RollMenu   (                  FarLeft );  { ^Home & ^Left }
          #117,#116:RollMenu   (                  FarRight);  { ^End & ^Right }
          HelpKey:  PullHelpWndw (HelpWndwNum,Title);         { F1 }
          PopKey:   PopToWorkWndw:=true;                      { F2 }
          TopKey1:  PopToTop:=true;                           { F10 }
        end      { end case }
      else
        begin
          CheckSelection (MainMenu[MPulled]);
          SPulled:=0
        end;
      CheckForPop
    end;  { with }
  until (Key=EscKey) or Pop;
  Key := ' ';
  RemoveWindow;
  CmdSeq[0] := char(0);
  if not Pop then ShowMsg (2)
end;

procedure PullTopMenu;
var  Position, MPnew: integer;
begin
  ShowTopHiLite;
  repeat
    CheckForPull;
    if not Pull then
      begin
        ShowMsg (2);
        ReadKB (ExtKey,Key)
      end;
    MPnew:=MPulled;
    if ExtKey then
      begin
        case Key of
          #75:      if MPulled=1 then                { Left  arrow }
                         MPnew:=LastMainMenu
                    else MPnew:=pred(MPulled);
          #77:      if MPulled=LastMainMenu then     { Right arrow }
                         MPnew:=1
                    else MPnew:=succ(MPulled);
          #71,#119,#115,#73: MPnew:=1;               { Home,^Home,^Left,PgUp }
          #79,#117,#116,#81: MPnew:=LastMainMenu;    { End, ^End,^Right,PgDn }
          HelpKey:  PullHelpWndw (2,'Top Menu');     { F1 }
          PopKey:   PopToWorkWndw:=true;             { F2 }
        end;
        MoveTopHiLite (MPnew);
      end
    else
      begin
        Position := pos (upcase(Key),TopCmdLtrs);
        if Position<>0 then
          begin
            MPnew:=Position;
            Key:=RetKey
          end;
        if Key=RetKey then
          begin
            MoveTopHiLite (MPnew);
            PullMainMenu;
            PopToTop:=false;
          end
      end;
    CheckForPop;
  until (Key=EscKey) or Pop;
  ShowTopMenu;
end;

procedure GotoMenus;
begin
  InWorkWndw:=false;
  CursorOff;
  CmdSeq[0]:=char(0);
  if TopKeyPressed then
    begin
      Pull:=false;
      MoreCmdSeq[0]:=char(0);
    end;
  PullTopMenu;
  InWorkWndw:=true;
  if PopAndProcess then Process (OldMPulled,OldSPulled,OldHiLited);
  CursorOn;
end;

procedure GotoWorkWndw;
begin
  repeat
    WorkWndw;
    if ExtKey then
      case Key of
        PopKey,TopKey1:  Pull:=true;
      end
    else
      case Key of
        EscKey,TopKey2:  Pull:=true;
      end;
  until Pull or Quit;
end;

procedure ClearPopFlags;
begin
  PopToWorkWndw := false;
  PopToTop      := false;
  PopLevels     := 0;
  Pop           := false;
  PopAndProcess := false;
end;

procedure GotoKeyDispatcher;
begin
  repeat
    ClearPopFlags;
    if Pull then
         GotoMenus
    else GotoWorkWndw;
  until Quit
end;

{ ALL of the remaining procedures could be made overlays; they are used once
  for initialization and never used again. }

procedure CheckCursor;
var CursorMode: integer absolute $0000:$0460;
begin
  if ActiveDD=MdaMono then
    if CursorMode=$0607 then   { Some BIOS set the wrong default! }
      CursorChange ($0B0C,i);
end;

procedure InitMenuSize;
var Lmax,L,L2: integer;
{}procedure GetRowsAndCols (VAR Menu: MenuRec);
  var CmdLtr: char;
  begin
    with Menu do
      begin
        Rows := MenuLines+2;
        Lmax := 0;
        CmdLtrs[0] := char(0);
        for j:=1 to MenuLines do
          begin
            L := ord(Line[j][0]);
            if L>Lmax then Lmax:=L;
            case LineMode[j] of
              Comment,Partition: CmdLtr:=#00; { #00 - for inaccessible lines. }
            else CmdLtr:=upcase(Line[j][1]);
            end;  { case }
            CmdLtrs := CmdLtrs+CmdLtr;
          end;
        Cols:= Lmax+8
      end
{}end;  { procedure }
{}procedure SetMenuDefaults (VAR Menu: MenuRec; MenuBrdr: Borders);
  begin
    with Menu do
      begin
        GetRowsAndCols (Menu);
        Border := MenuBrdr;
        HiLiteLine := DefaultLine;
        case MenuMode of
          SingleChoice,ExecSingleChoice: Flagged[SingleFlagLine]:=true;
        end;
      end;
{}end;  { procedure }
begin
  for i:=1 to NumOfMainMenus do SetMenuDefaults (MainMenu[i],MainMenuBrdr);
  for i:=1 to NumOfSubMenus  do SetMenuDefaults (SubMenu[i] ,SubMenuBrdr);
  for i:=1 to NumOfHelpWndws do
    begin
      with HelpWndw[i] do
        begin
          Rows   := LastLine-FirstLine+3;
          Cols   := HelpCharsPerLine+4;
          Border := HelpWndwBrdr;
          Zoom   := HelpZoom;
          LinesToShow:=succ(LastLine-FirstLine);
       end
    end
end;

procedure InitMenuColor;
begin
  for i:=1 to NumOfMainMenus do
    with MainMenu[i] do
      begin
        Hattr := MainMenuHattr;
        Wattr := MainMenuWattr;
        Battr := MainMenuBattr;
        Lattr := MainMenuLattr;
        Cattr := MainMenuCattr;
      end;
  for i:=1 to NumOfSubMenus do
    with SubMenu[i] do
      begin
        Hattr := SubMenuHattr;
        Wattr := SubMenuWattr;
        Battr := SubMenuBattr;
        Lattr := SubMenuLattr;
        Cattr := SubMenuCattr;
      end;
  for i:=1 to NumOfHelpWndws do
    with HelpWndw[i] do
      begin
        Wattr      := HelpWndwWattr;
        Battr      := HelpWndwBattr;
        Shadow     := HelpShadow;
        MsgLineNum := HelpMsgLineNum;
      end;
end;

procedure LocateMainMenus;
begin
  fillchar (TopMenuStr,succ(CRTcols),' ');
  TopMenuStr:=' ≡';
  TopCmdLtrs[0]:=char(0);
  for i:=1 to NumOfMainMenus do
    with MainMenu[i] do
      begin
        Row := MainMenuRow;
        Col := succ(ord(TopMenuStr[0]));
        NameCol := succ(Col);
        TopMenuStr := TopMenuStr + '  ' + Title;
        TopCmdLtrs := TopCmdLtrs + upcase(Title[1]);
        if Cols+Col>pred(CRTcols) then Col:=pred(CRTcols-Cols);
      end;
  TopMenuStr[0] := char(CRTcols)
end;

procedure LocateSubMenus;   { and DataWndws }
var RoomL,RoomR,RoomMax,TestWidth,QtyL,QtyR: integer;
{}procedure FindLinkDir (VAR Menu: MenuRec);
  begin
    with Menu do
    begin
      RoomL := Col;
      RoomR := CRTcols-(pred(Col)+Cols);
      if RoomR>=RoomL then RoomMax:=RoomR else RoomMax:=RoomL;
      QtyL:=0; QtyR:=0;
      for j:=1 to MenuLines do
        case LineMode[j] of ToDataWndw,ToSubMenu:
          begin
            case LineMode[j] of
              ToSubMenu:  TestWidth:=SubMenu[LinkNum[j]].Cols;
              ToDataWndw: TestWidth:=DataWndw[LinkNum[j]].Cols;
            end;
            if TestWidth<=RoomMax then
              begin
                if TestWidth<=RoomR then QtyR:=succ(QtyR);
                if TestWidth<=RoomL then QtyL:=succ(QtyL);
              end
            else if (LineMode[j]=ToSubMenu) and LocationWarning then
                    writeln ('No room for SubMenu[',j,']',^G^G);
          end
        end;  { case LineMode }
      if QtyR>=QtyL then LinkDir:=Right else LinkDir:=Left;
    end { with }
{}end; { procedure }
{}procedure AssignLocations (VAR Menu: MenuRec);
  begin
    with Menu do
      for j:=1 to MenuLines do
        case LineMode[j] of
          ToSubMenu:
            with SubMenu[LinkNum[j]] do
              begin
                case Menu.LinkDir of
                  Right: Col:=Menu.Col+(Menu.Cols-2);
                  Left:  Col:=Menu.Col-(Cols-2);
                end;
                Row:=Menu.Row+j;
                if (Row+Rows)>CRTrows-2 then Row:=pred(CRTrows-Rows);
                Title:=Menu.Line[j]
              end;
          ToDataWndw:
            begin
              case LinkDir of
                Right: RoomMax:=CRTcols-(pred(Col)+Cols);
                Left:  RoomMax:=Col;
              end;
              with DataWndw[LinkNum[j]] do
                if Cols>RoomMax then
                  begin
                    RowAlt := succ((CRTrows-Rows) shr 1);
                    ColAlt := succ((CRTcols-Cols) shr 1)
                  end;
            end
        end    { case }
{}end; { procedure }
begin
  for i:=1 to NumOfMainMenus do FindLinkDir (MainMenu[i]);
  for i:=1 to NumOfMainMenus do AssignLocations (MainMenu[i]);
  for i:=1 to NumOfSubMenus  do FindLinkDir (SubMenu[i]);
  for i:=1 to NumOfSubMenus  do AssignLocations (SubMenu[i]);
end;

procedure LocateHelpWndws;
begin
  for i:=1 to NumOfHelpWndws do
    with HelpWndw[i] do
      begin
        Row := succ(CRTrows-Rows-RowsBelowHelp);
        Col := succ((CRTcols-Cols) shr 1);
      end
end;

procedure ClearPullStats;
begin
 fillchar (MainMenu,SizeOf(MainMenu),0);
 fillchar (SubMenu ,SizeOf(SubMenu) ,0);
 fillchar (DataWndw,SizeOf(DataWndw),0);
 fillchar (HelpWndw,SizeOf(HelpWndw),0)
end;

procedure InitPull (Attrib: integer);
begin
  InitAttr:=Attrib;
  InitWindow (InitAttr);
  CheckCursor;
    CRTcols:=CRTcolumns;
    InWorkWndw:=true;
    Quit:=false;
  ClearPullStats;
  GetUserPullStats;
  InitMenuSize;
  InitMenuColor;
  InitDataWndwSize;
  InitDataWndwColor;
  LocateMainMenus;
  LocateSubMenus;
  LocateHelpWndws;
  GetOverrideStats
end;