Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/PULLDOWN.ZIP/PULL11.INC

Text File | 1987-02-27 | 27.0 KB | 903 lines

{ Pull11.inc - Turbo Pascal full featured pull-down menus.  ver 1.1, 02-27-87 }
{ (c) 1987 James H. LeMay, Arthur J. Hill                                     }
type
  SelectModeType = (Choice, NoChoice, ToDataWndw, ToSubMenu);
  MenuModeType   = (ExecChoice, SingleChoice, MultipleChoice);
  TypeOfDataType = (Bytes, Integers, Reals, Chars, Strings);
  Toggle         = (Off, On, No, Yes);
  MaxString      = string[MaxStringLength];
  ErrMsgString   = string[MaxErrStrLength];
  { Careful! -- if you change any record, ClearPullStats must also be changed.}
  MenuRec = record
              Title:        string[MaxCharsPerLine];
              CmdLtrs:      string[MaxMenuLines];
              Line:         array[1..MaxMenuLines] of string[MaxCharsPerLine];
              Selected:     array[1..MaxMenuLines] of boolean;
              SelectMode:   array[1..MaxMenuLines] of SelectModeType;
              LinkNum:      array[1..MaxMenuLines] of byte;
              LinkDir:      DirType;
              MenuMode:     MenuModeType;
              MenuLines:    byte;
              NameCol:      byte;
              Row, Col, Rows, Cols, DefaultLine, HiLited, SingleSel: byte;
              Wattr, HiAttr, Battr:     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;
              Wattr, HiAttr, Battr:     byte;
              Border:                   Borders;
              MsgLineNum, HelpWndwNum:  byte;
              ErrorMsgNum:              integer;
            end;
  HelpWndwRec = record
              FirstLine, LastLine:      byte;
              LinesToShow:              byte;
              Row, Col, Rows, Cols:     byte;
              Wattr, Battr:             byte;
              Border:                   Borders;
              Zoom:                     boolean;
              Shadow:                   DirType;
              MsgLineNum:               byte
            end;
  DataPadRec = record
              Store:      boolean;
              case TypeOfData: TypeOfDataType of
                Bytes:    (B: byte);
                Integers: (I: integer);
                Reals:    (R: real);
                Chars:    (C: char);
                Strings:  (S: MaxString);
            end;
  MainMenuRecs  = array[1..NumOfMainMenus] of MenuRec;
  SubMenuRecs   = array[1..NumOfSubMenus]  of MenuRec;
  DataWndwRecs  = array[1..NumOfDataWndws] of DataWndwRec;
  HelpWndwRecs  = array[1..NumOfHelpWndws] of HelpWndwRec;

const
  HideCursor: integer = $2020;

var
  MainMenu: MainMenuRecs;
  SubMenu:  SubMenuRecs;
  DataWndw: DataWndwRecs;
  HelpWndw: HelpWndwRecs;
  HelpLine: array[1..TotalHelpLines] of string[HelpCharsPerLine];
  MsgLine:  array[1..NumOfMsgLines] of MaxString;
  ErrMsgLine: array[1..NumOfErrMsgLines] of ErrMsgString;

  TopMenuRow,    MainMenuRow,
  TopMenuAttr,   TopHilitAttr,  MsgLineAttr,
  MainMenuWattr, MainMenuBattr, MainHilitAttr,
  SubMenuWattr,  SubMenuBattr,  SubHilitAttr,
  DataWndwWattr, DataWndwBattr,
  HelpWndwWattr, HelpWndwBattr: byte;
  MainMenuBrdr,  SubMenuBrdr, DataWndwBrdr, HelpWndwBrdr: Borders;
  HelpShadow:    DirType;
  HelpZoom:      boolean;
  TopCmdLtrs:    string[NumOfMainMenus];
  CmdSeq,LastCmdSeq: string[MaxWndw];
  RowsBelowHelp,RowsBelowMsg: byte;

  CRTcols, CRTrows: integer;
  CRTcolumns:  integer absolute $0040:$004A;
  KeyStat:     byte    absolute $0040:$0017;
  AutoNumLock: boolean;
  LastKeyStat: byte;

  OldCursor, DOScursor, MainScrCursor,
  LastMainPulled, MPulled, SPulled,i,j: integer;
  TopMenuStr:        MaxString;
  DataPad:           DataPadRec;
  ExtKey, Quit:      boolean;
  LocationWarning:   boolean;
  Pull, Pop, ToTop:  boolean;
  Ch:                char;

procedure DataTransfer (VAR DataPad: DataPadRec; HiLt: byte;
                        VAR ErrMsg: integer); forward;
procedure Process (MPulled,SPulled,HiLt: byte); forward;
procedure GetUserPullStats; forward;
procedure GetOverrideStats; forward;

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

procedure NumLockOn;
begin
  LastKeyStat := KeyStat;
  KeyStat := LastKeyStat or $20;
  QwriteC (CRTrows,1,CRTcols,-1,'NUMLOCK')
end;

procedure NumLockOff;
begin
  KeyStat := (KeyStat and $DF) or (LastKeyStat and $20)
end;

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

procedure ShowMenu (VAR Menu: MenuRec);
var C:      byte;
    Symbol: string[1];
begin
  With Menu do
  begin
    MakeWindow (Row,Col,Rows,Cols,Wattr,Battr,Border);
    for i:=1 to Rows do
    begin
      if Selected[i] then Qwrite (Row+i,Col+2,-1,#16);
      QwriteV (Row+i,Col+3,-1,Line[i]);
      if SelectMode[i] in [ToSubMenu,ToDataWndw] then
      begin
        case LinkDir of
          Left:  C:=Col+1;
          Right: C:=Col+Cols-2;
        end;
        case SelectMode[i] of
          ToSubMenu:  Symbol:=#240;
          ToDataWndw: Symbol:=#250;
        end;
        QwriteV (Row+i,C,-1,Symbol)
      end
    end;
    if BackToDefault then HiLited:=DefaultLine;
    Qattr (Row+HiLited,Col+1,1,Cols-2,HiAttr);
  end
end;

procedure RollHiLite (VAR Menu: MenuRec; Dir: DirType);
begin
  With Menu do
  begin
    Qattr (Row+HiLited,Col+1,1,Cols-2,Wattr);
    repeat
      case Dir of
        Up:     if HiLited=1 then HiLited:=MenuLines else HiLited:=HiLited-1;
        Down:   if HiLited=MenuLines then HiLited:=1 else HiLited:=HiLited+1;
        Top:    begin
                  HiLited:=1;
                  Dir:=Down
                end;
        Bottom: begin
                  HiLited:=MenuLines;
                  Dir:=Up
                end;
      end;  { case }
    until SelectMode[HiLited]<>NoChoice;
    Qattr (Row+HiLited,Col+1,1,Cols-2,HiAttr)
  end
end;

procedure ShowTopHiLited;
begin
  with MainMenu[MPulled] do
    Qattr (TopMenuRow,NameCol,1,length(Title)+2,TopHilitAttr);
end;

procedure ClearTopHiLited;
begin
  Qattr (TopMenuRow,1,1,CRTcols,TopMenuAttr);
end;

procedure RollMenu (Dir: DirType);
begin
  RemoveWindow;
  ClearTopHiLited;
  case Dir of
    Left:     if MPulled=1 then MPulled:=NumOfMainMenus else MPulled:=MPulled-1;
    Right:    if MPulled=NumOfMainMenus then MPulled:=1 else MPulled:=MPulled+1;
    FarLeft:  MPulled:=1;
    FarRight: MPulled:=NumOfMainMenus;
  end;
  with MainMenu[MPulled] do
  begin
    ShowTopHiLited;
    ShowMenu (MainMenu[MPulled]);
    ShowMsg (MsgLineNum)
  end;
  CmdSeq:=TopCmdLtrs[MPulled]
end;

procedure DoChoice (VAR Menu: MenuRec; VAR Sel: boolean);
type Str1 = string[1];
{}procedure ShowFlag (Flag: Str1);
  begin
    with Menu do
      QwriteV (Row+HiLited,Col+2,-1,Flag)
{}end;
begin
  with Menu do
  case MenuMode of
    ExecChoice:     Process (MPulled,SPulled,HiLited);
    SingleChoice:   if Sel<>true then
                    begin
                      Selected[SingleSel] := false;
                      Sel := true;
                      Qwrite (Row+SingleSel,Col+2,-1,' ');
                      ShowFlag (^P);
                      SingleSel := HiLited;
                      Changed := true
                    end;
    MultipleChoice: begin
                      Changed := true;
                      case Sel of
                        true:  begin
                                 Sel:=false;
                                 ShowFlag (' ')
                               end;
                        false: begin
                                 Sel:=true;
                                 ShowFlag (^P)
                               end
                      end
                    end;
  end  { case }
end;

procedure PullHelpWndw (WndwNum,MsgLNum: byte; Title: MaxString);
begin
  CursorChange (HideCursor,OldCursor);
  with HelpWndw[WndwNum] do
  begin
    ZoomEffect:=HelpZoom;
    ShadowEffect:=HelpShadow;
    ShowMsg (MsgLineNum);
    MakeWindow (Row,Col,Rows,Cols,Wattr,Battr,Border);
    TitleWindow (Center,' Help for "'+Title+'" ');
    for i:=FirstLine to FirstLine+LinesToShow-1 do
      QwriteV (Row+1+i-FirstLine,Col+2,-1,HelpLine[i]);
  end;
  repeat
    ReadKB (ExtKey, Ch);
    if ExtKey and (Ch=#59) then Ch:=^[; { F1  key }
  until Ch=^[;                          { ESC key }
  Ch:=' ';
  RemoveWindow;
  ShowMsg (MsgLNum);
  CursorChange (OldCursor,i);
  ZoomEffect:=false;
  ShadowEffect:=NoDir
end;

procedure TurnArrows (Switch: Toggle; VAR Menu: MenuRec);
var Arrow: string[1];
    R,C: byte;
begin
  with Menu do
  begin
    R:=Row+HiLited;
    case LinkDir of
      Left:  begin Arrow:=^Q; C:=1; end;
      Right: begin Arrow:=^P; C:=0; end;
    end;
    if Switch=Off then Arrow:=' ';
    QwriteV (R,Col+1+C     ,-1,Arrow);
    QwriteV (R,Col+Cols-3+C,-1,Arrow);
    if not Pop and (Switch=Off) then ShowMsg (MsgLineNum)
  end
end;

procedure ShowDataWndw (VAR Menu: MenuRec; VAR DWndw: DataWndwRec);
var DataPadStr:                   MaxString;
    FieldCol,PadStrCol,CursorCol: byte;
{}procedure FindRowCol;
  begin
    with DWndw do
      if RowAlt+ColAlt=0 then
        begin
          Row:=Menu.Row+Menu.HiLited;
          if (Row+Rows)>CRTrows-2 then Row:=CRTrows-Rows-1;
          case Menu.LinkDir of
            Right: Col:=Menu.Col+(Menu.Cols-2);
            Left:  Col:=Menu.Col-(Cols-2)
          end
        end
      else
        begin
          Row:=RowAlt;
          Col:=ColAlt
        end;
{}end;
{}procedure ConvertDataToStr;
  var ErrMsg: integer;
  begin
    with DWndw do
    begin
      DataPad.TypeOfData := TypeOfData;
      DataPad.Store := false;
      DataTransfer (DataPad,Menu.HiLited,ErrMsg);
      with DataPad do
        case TypeOfData of
          Bytes:     Str(B:Field,DataPadStr);
          Integers:  Str(I:Field,DataPadStr);
          Reals:     if Decimals<0 then Str(R:Field,DataPadStr)
                     else
                       begin
                         Str(R:Field:Decimals,DataPadStr);
                         if length(DataPadStr)>Field then
                           Str(R:Field,DataPadStr)
                       end;
          Chars:     DataPadStr:='"'+C+'"';
          Strings:   DataPadStr:='"'+S+'"';
        end
    end
{}end;
begin
  with DWndw do
  begin
    FindRowCol;
    MakeWindow (Row,Col,Rows,Cols,Wattr,Battr,Border);
    for i:=1 to 2 do
      QwriteV (Row+i,Col+2,-1,Line[i]);
    ConvertDataToStr;
    ShowMsg (MsgLineNum);
    FieldCol:=Col+FirstCol;
    case TypeOfData of
      Bytes..Reals:  begin
                       PadStrCol:=FieldCol;
                       CursorCol:=FieldCol+Field-1;
                       if AutoNumLock then NumLockOn
                     end;
      Chars,Strings: begin
                       PadStrCol:=FieldCol-1;
                       CursorCol:=FieldCol
                     end;
    end;
    QwriteV (Row+1,PadStrCol     ,-1,DataPadStr);
    Qwrite  (Row+2,FieldCol-1    ,-1,'»');
    Qwrite  (Row+2,FieldCol+Field,-1,'«');
    GotoRC  (Row+2,CursorCol);
    CursorChange (DOScursor,i);
  end
end;

procedure CheckForPull;
begin
  if Pull then
  begin
    if LastCmdSeq='' then Pull:=false
    else
      begin
        Ch:=LastCmdSeq[1];
        Delete (LastCmdSeq,1,1)
      end;
    ExtKey:=false
  end
end;

procedure ShowErrorMsg (ErrMsgNum: integer; MsgLnNum: byte);
var Row,L: byte;
begin
  Row:=CRTrows-RowsBelowMsg;
  QwriteV (Row,1,MsgLineAttr,ErrMsgLine[ErrMsgNum]);
  L:=length(ErrMsgLine[ErrMsgNum]);
  Qfill   (Row,L+1,1,CRTcols-L,-1,' ');
  repeat
    sound (100);
    delay (30);
    nosound;
    ReadKB (ExtKey,Ch);
  until Ch=^[;
  Ch:=' ';
  ShowMsg (MsgLnNum)
end;

procedure PullDataWndw (VAR Menu: MenuRec; WndwNum: byte);
{}procedure AcceptDataEntry;
  var ValidChSet:            set of char;
      DataEntryStr,VideoStr: MaxString;
      C:                     byte;
      Space:                 string[1];
      Null:                  boolean;
{--}procedure AppendStr;
    var L: byte;
    begin
      L:=length(DataEntryStr);
      Space:='';
      Null:=false;
      case Ch of
        ^H:  begin
               if L>0 then
               begin
                 DataEntryStr[0]:=pred(DataEntryStr[0]);
                 Space:=' '
               end
             end;
      else if L<DataWndw[WndwNum].Field then
             DataEntryStr:=DataEntryStr+Ch;
      end  { case }
{--}end;
{--}procedure StoreData;
    var Errors: integer;
    begin
      with DataPad do
      begin
        Errors:=0;
        case TypeOfData of
          Bytes..Reals:
            begin
              case TypeOfData of
                Bytes:    begin
                            val(DataEntryStr,I,Errors);
                            if (Errors=0)and(I>255) then Errors:=1;
                          end;
                Integers: val(DataEntryStr,I,Errors);
                Reals:    val(DataEntryStr,R,Errors);
              end;  { case }
              if Errors<>0 then
                with DataWndw[WndwNum] do
                  ShowErrorMsg (ErrorMsgNum,MsgLineNum);
            end;
          Chars:   if Null then
                        C:=^@
                   else C:=DataEntryStr[1];
          Strings: S:=DataEntryStr;
        end;  { case }
        if Errors=0 then
        begin
          Store:=true;
          DataTransfer (DataPad,Menu.HiLited,Errors);
          if Errors<>0 then
               ShowErrorMsg (Errors,DataWndw[WndwNum].MsgLineNum)
          else Menu.Changed := true
        end
      end   { with }
{--}end;  { procedure }
{}begin
    with DataWndw[WndwNum] do
    begin
      DataEntryStr:='';
      Null:=false;
      case TypeOfData of
        Bytes:           ValidChSet:=['0'..'9',^H];
        Integers:        ValidChSet:=['0'..'9','-','+',^H];
        Reals:           ValidChSet:=['0'..'9','-','+','.','E','e',^H];
        Chars, Strings:  ValidChSet:=[' '..'~',^H,#00]
      end;
      if not Pull then CmdSeq:=CmdSeq+Menu.CmdLtrs[Menu.HiLited];
      CheckForPull;
      repeat
        ReadKB (ExtKey,Ch);
        if ExtKey then
          case Ch of
            #59: PullHelpWndw (HelpWndwNum,MsgLineNum,
                                Menu.Line[Menu.HiLited]); { F1 }
            #83: if #00 in ValidChSet then
                 begin
                   Qfill (Row+2,Col+FirstCol,1,Field,-1,' ');
                   DataEntryStr:='';
                   Null:=true;
                   GotoRC (Row+2,Col+FirstCol)
                 end;
            #60: Pop:=true;  { F2 }
          end      { end case }
        else
          if Ch in ValidChSet then
            begin
              case TypeOfData of
                Bytes..Reals:
                  begin
                    AppendStr;
                    VideoStr:=Space+DataEntryStr;
                    C:=Col+FirstCol+Field-length(VideoStr);
                  end;  { Bytes..Reals }
                Chars,Strings:
                  begin
                    AppendStr;
                    VideoStr:=DataEntryStr+Space;
                    C:=Col+FirstCol;
                    GotoRC (Row+2,Col+FirstCol+length(DataEntryStr))
                  end;  { Chars,Strings }
              end;  { case }
              QwriteV (Row+2,C,-1,VideoStr)
            end
          else
            if Ch='/' then ToTop:=true;
        if (Ch=^M) and ((DataEntryStr<>'') or Null) then StoreData;
      until (Ch in [^M,^[]) or Pop or ToTop;
      if not Pop then CmdSeq[0]:=pred(CmdSeq[0]);
      if (TypeOfData in [Bytes..Reals]) and AutoNumLock then NumLockOff
    end  { with }
{}end;
begin
  TurnArrows (On,Menu);
  ShowDataWndw (Menu,DataWndw[WndwNum]);
  AcceptDataEntry;
  with Menu do
    begin
      if (MenuMode=ExecChoice)and(Ch=^M) then Process(MPulled,SPulled,HiLited);
      Ch:=' '
    end;
  CursorChange (HideCursor,i);
  RemoveWindow;
  TurnArrows (Off,Menu)
end;

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

procedure CheckSelection (VAR Menu: MenuRec);
var Position: byte;
{}procedure MoveHiLite (Att: byte);
  begin
    with Menu do
      Qattr (Row+HiLited,Col+1,1,Cols-2,Att)
{}end;
begin
  with Menu do
  begin
    if Ch='/' then ToTop:=true;
    Position := pos (upcase(Ch),CmdLtrs);
    if Position<>0 then
      begin
        MoveHiLite (Wattr);
        HiLited := Position;
        MoveHiLite (HiAttr);
        Ch:=^M
      end;
    if Ch=^M then
      case SelectMode[HiLited] of
        ToSubMenu:  PullSubMenu  (Menu,LinkNum[HiLited]);
        ToDataWndw: PullDataWndw (Menu,LinkNum[HiLited]);
        Choice:     DoChoice     (Menu,Selected[HiLited]);
      end;
  end  { with }
end;

procedure PullSubMenu;
begin
  SPulled:=MenuNum;
  with Menu do
    if not Pull then CmdSeq:=CmdSeq+CmdLtrs[HiLited];
  TurnArrows (On,Menu);
  ShowMenu (SubMenu[MenuNum]);
  with SubMenu[MenuNum] do
  begin
    CheckForPull;
    if not Pull then ShowMsg (MsgLineNum);
    repeat
      if not Pull then ReadKB (ExtKey,Ch);
      if ExtKey then
        case Ch 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 }
          #59:     PullHelpWndw (HelpWndwNum,MsgLineNum,Title);  { F1 }
          #60:     Pop:=true; { F2 }
        end      { end case }
      else  CheckSelection (SubMenu[MenuNum]);
    until (Ch=^[) or Pop or ToTop;
    Ch:=' ';
    RemoveWindow;
    if not Pop then CmdSeq[0]:=pred(CmdSeq[0]);
    TurnArrows (Off,Menu)
  end  { with }
end;

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

procedure PullTopMenu;
var Position: byte;
begin
  LastMainPulled:=MPulled;
  ShowTopHiLited;
  CheckForPull;
  if not Pull then ShowMsg (2);
  repeat
    if not Pull then ReadKB (ExtKey,Ch);
    if ExtKey then
      begin
        case Ch of
          #75:      if MPulled=1 then                { Left  arrow }
                         MPulled:=NumOfMainMenus
                    else MPulled:=MPulled-1;
          #77:      if MPulled=NumOfMainMenus then   { Right arrow }
                         MPulled:=1
                    else MPulled:=MPulled+1;
          #71,#115: MPulled:=1;                      { Home & ^Left }
          #79,#116: MPulled:=NumOfMainMenus;         { End & ^Right }
          #59:      PullHelpWndw (2,2,'Top Menu');   { F1 }
          #60:      Pop:=true;                       { F2 }
        end;
        if MPulled<>LastMainPulled then
          begin
            LastMainPulled:=MPulled;
            ClearTopHiLited;
            ShowTopHiLited
          end
      end
    else
      begin
        Position := pos (upcase(Ch),TopCmdLtrs);
        if Position<>0 then
          begin
            MPulled := Position;
            Ch:=^M
          end;
        if Ch=^M then
          begin
            if LastMainPulled<>MPulled then ClearTopHiLited;
            ToTop:=false;
            PullMainMenu;
            LastMainPulled := MPulled
          end
      end;
  until (Ch=^[) or Pop;
end;

procedure GoToMenus;
begin
  Pop := false;
  CursorChange (HideCursor,i);
  case Ch of
    ^[:  begin
           LastCmdSeq:=CmdSeq;
           Pull:=true
         end;
    '/': begin
           CmdSeq:='';
           Pull:=false
         end;
  end;
  PullTopMenu;
  ClearTopHiLited;
  CursorChange (MainScrCursor,i)
end;

procedure InitMenuSizeAndColor;
var Lmax,L,L2: integer;
{}procedure GetRowsAndCols (VAR Menu: MenuRec);
  var CmdLtr: char;
  begin
    with Menu do
    begin
      Rows := MenuLines+2;
      Lmax := 0;
      CmdLtrs := '';
      for j:=1 to MenuLines do
      begin
        L := length (Line[j]);
        if L>Lmax then Lmax:=L;
        if SelectMode[j]<>NoChoice then
             CmdLtr:=upcase(Line[j][1])
        else CmdLtr:=^@;
        CmdLtrs := CmdLtrs + CmdLtr;
      end;
      Cols:= Lmax+6
    end
{}end;  { procedure }
begin
  for i:=1 to NumOfMainMenus do
    with MainMenu[i] do
    begin
      GetRowsAndCols (MainMenu[i]);
      HiAttr := MainHiLitAttr;
      Wattr := MainMenuWattr;
      Battr := MainMenuBattr;
      Border := MainMenuBrdr;
      HiLited := DefaultLine;
      if MenuMode=SingleChoice then Selected[SingleSel]:=true
    end;
  for i:=1 to NumOfSubMenus do
  begin
    with SubMenu[i] do
    begin
      GetRowsAndCols (SubMenu[i]);
      HiAttr := SubHiLitAttr;
      Wattr := SubMenuWattr;
      Battr := SubMenuBattr;
      Border := SubMenuBrdr;
      HiLited := DefaultLine;
      if MenuMode=SingleChoice then Selected[SingleSel]:=true
    end;
  end;
  for i:=1 to NumOfDataWndws do
  begin
    with DataWndw[i] do
    begin
      Rows := 4;
      L  := length(Line[1]);
      L2 := length(Line[2]);
      if L>=L2 then Lmax:=L else Lmax:=L2;
      Cols := Lmax+6+Field;
      FirstCol := Lmax+4;
      Wattr  := DataWndwWattr;
      Battr  := DataWndwBattr;
      Border := DataWndwBrdr
    end;
  end;
  for i:=1 to NumOfHelpWndws do
  begin
    with HelpWndw[i] do
    begin
      Rows   := LastLine-FirstLine+3;
      Cols   := HelpCharsPerLine+4;
      Wattr  := HelpWndwWattr;
      Battr  := HelpWndwBattr;
      Border := HelpWndwBrdr;
      Zoom   := HelpZoom;
      Shadow := HelpShadow
    end;
  end
end;

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

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

procedure ClearPullStats;
begin
 i := (MaxMenuLines+1)*(MaxCharsPerLine+2)+MaxMenuLines*3+19;
 fillchar (MainMenu[1],NumOfMainMenus*i,^@);
 fillchar (SubMenu[1], NumOfSubMenus *i,^@);
 fillchar (DataWndw[1],NumOfDataWndws*((MaxCharsPerLine+1)*2+19),^@);
 fillchar (HelpWndw[1],NumOfHelpWndws*13,^@)
end;

procedure InitPull;
begin
  InitWindow (Attr(yellow,black));
  ClearPullStats;
  CRTcols:=CRTcolumns;
  Quit:=false;
  CursorChange (HideCursor,DOScursor);
  MainScrCursor:=DOScursor;
  CursorChange (DOScursor,i);
  GetUserPullStats;
  InitMenuSizeAndColor;
  LocateMainMenus;
  LocateSubMenus;
  LocateHelpWndws;
  GetOverrideStats
end;