home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / turbopas / pull15.arc / PULL15.INC < prev    next >
Text File  |  1987-08-31  |  26KB  |  856 lines
  1. { Pull15.inc - Turbo Pascal full featured pull-down menus.  ver 1.5, 08-31-87 }
  2. { (c) 1987 James H. LeMay                                                     }
  3.  
  4. type
  5.   LineModeType   = (Choice, ExecOnly, Comment, Partition,
  6.                     ToDataWndw, ToSubMenu, ToUserWndw);
  7.   MenuModeType   = (ExecChoice, ExecSingleChoice, ExecMultipleChoice,
  8.                     SingleChoice, MultipleChoice);
  9.   TypeOfDataType = (Bytes,Integers,Reals,UserNums,Chars,Strings,UserStrings);
  10.   Toggle         = (Off, On, No, Yes);
  11.   MaxString      = string[MaxStringLength];
  12.   ErrMsgString   = string[MaxErrStrLength];
  13.   MenuRec = record
  14.               Title:        string[MaxCharsPerLine];
  15.               CmdLtrs:      string[MaxMenuLines];
  16.               Line:         array[1..MaxMenuLines] of string[MaxCharsPerLine];
  17.               LineMode:     array[1..MaxMenuLines] of LineModeType;
  18.               Flagged:      array[1..MaxMenuLines] of boolean;
  19.               LinkNum:      array[1..MaxMenuLines] of byte;
  20.               LinkDir:      DirType;
  21.               MenuMode:     MenuModeType;
  22.               MenuLines:    byte;
  23.               NameCol:      byte;
  24.               Row, Col, Rows, Cols:                    byte;
  25.               DefaultLine, HiLiteLine, SingleFlagLine: byte;
  26.               Battr, Wattr, Hattr, Lattr, Cattr:       byte;
  27.               Border:                                  Borders;
  28.               BackToDefault, Changed:                  boolean;
  29.               MsgLineNum, HelpWndwNum:                 byte
  30.             end;
  31.   DataWndwRec = record
  32.               Line: array[1..2] of string[MaxCharsPerLine];
  33.               TypeOfData:               TypeOfDataType;
  34.               Row, Col, Rows, Cols:     byte;
  35.               RowAlt, ColAlt:           byte;
  36.               FirstCol, Field:          byte;
  37.               Decimals:                 integer;
  38.               Justify:                  DirType;
  39.               Battr, Wattr, Hattr:      byte;
  40.               Border:                   Borders;
  41.               MsgLineNum, HelpWndwNum:  byte;
  42.             end;
  43.   HelpWndwRec = record
  44.               FirstLine, LastLine:      byte;
  45.               LinesToShow:              byte;
  46.               Row, Col, Rows, Cols:     byte;
  47.               Battr, Wattr:             byte;
  48.               Border:                   Borders;
  49.               Zoom:                     boolean;
  50.               Shadow:                   DirType;
  51.               MsgLineNum:               byte
  52.             end;
  53.  
  54. const
  55.   HelpKey = #59;    { F1 }   { Set equal to #00 if Help access is not wanted. }
  56.   PopKey  = #60;    { F2 }
  57.   TopKey1 = #68;    { F10 }  { Extended function key }
  58.   TopKey2 = #47;    { '/' }
  59.   EscKey  = #27;    { ^[ }
  60.   RetKey  = #13;    { ^M }
  61.   HideCursor = $2000;        { CursorMode to hide the cursor. }
  62.  
  63. var
  64.   MainMenu: array[1..NumOfMainMenus] of MenuRec;
  65.   SubMenu:  array[1..NumOfSubMenus]  of MenuRec;
  66.   DataWndw: array[1..NumOfDataWndws] of DataWndwRec;
  67.   HelpWndw: array[1..NumOfHelpWndws] of HelpWndwRec;
  68.   HelpLine: array[1..TotalHelpLines] of string[HelpCharsPerLine];
  69.   MsgLine:  array[1..NumOfMsgLines]  of MaxString;
  70.   ErrMsgLine:   array[1..NumOfErrMsgLines] of ErrMsgString;
  71.   TempMsgArray: array[1..512] of byte;
  72.  
  73.   TopMenuRow,    MainMenuRow,
  74.   InitAttr,      StatusAttr,
  75.   TopMenuAttr,   TopMenuHattr,  TopMenuLattr,  MsgLineAttr,
  76.   MainMenuWattr, MainMenuBattr, MainMenuHattr, MainMenuLattr, MainMenuCattr,
  77.   SubMenuWattr,  SubMenuBattr,  SubMenuHattr,  SubMenuLattr,  SubMenuCattr,
  78.   HelpWndwWattr, HelpWndwBattr: byte;
  79.   MainMenuBrdr,  SubMenuBrdr,  HelpWndwBrdr: Borders;
  80.   HelpShadow:    DirType;
  81.   HelpZoom:      boolean;
  82.   HelpMsgLineNum:integer;
  83.   TopCmdLtrs:    string[NumOfMainMenus];
  84.   CmdSeq,MoreCmdSeq: string[MaxWndw];
  85.   RowsBelowHelp,RowsBelowMsg: byte;
  86.  
  87.   CRTcols, CRTrows: integer;
  88.  
  89.   MPulled, SPulled, HiLited,i,j:      integer;
  90.   OldMPulled, OldSPulled, OldHiLited: integer;
  91.   TopMenuStr:       MaxString;
  92.   ExtKey, Quit:     boolean;
  93.   LocationWarning:  boolean;
  94.   Key:              char;
  95.  
  96.   Pull, Pop:        boolean;
  97.   PopLevels:        byte;
  98.   PopToWorkWndw, PopToTop, PopAndProcess, InWorkWndw: boolean;
  99.   WorkWndwStep:     integer;
  100.  
  101. { These are forward for access outside of PULL15.INC. }
  102. procedure Process (MPulled,SPulled,HiLited: integer);         forward;
  103. procedure GetUserPullStats;                                   forward;
  104. procedure GetOverrideStats;                                   forward;
  105. procedure WorkWndw;                                           forward;
  106. procedure PullDataWndw (VAR Menu: MenuRec; WndwNum: integer); forward;
  107. procedure InitDataWndwSize;                                   forward;
  108. procedure InitDataWndwColor;                                  forward;
  109. procedure PullUserWndw (VAR Menu: MenuRec; WndwNum: integer); forward;
  110.  
  111. procedure ReadKB (VAR ExtKey: boolean; VAR Key: char);
  112. begin
  113.   Read (Kbd,Key);                        { Read keyboard input.      }
  114.   if KeyPressed and (Key=EscKey) then    { If first Char was ESC ... }
  115.     begin
  116.       Read (Kbd,Key);                    { ... read second char.     }
  117.       ExtKey := true
  118.     end
  119.   else ExtKey:=false;
  120. end;
  121.  
  122. procedure ShowMsg (MsgNum: integer);
  123. begin
  124.     QwriteV (CRTrows-RowsBelowMsg,1,MsgLineAttr,MsgLine[MsgNum])
  125. end;
  126.  
  127. procedure HiLiteLetter (VAR Menu: MenuRec; HLine: integer);
  128. begin
  129.   with Menu do
  130.     Qattr (Row+HLine,Col+3+pos(CmdLtrs[HLine],Line[HLine]),1,1,Lattr);
  131. end;
  132.  
  133. procedure MoveHiLite (VAR Menu: MenuRec; HLnew: integer);
  134. begin
  135.   with Menu do
  136.     if HLnew<>HiLiteLine then
  137.       begin
  138.         Qattr (Row+HiLiteLine,succ(Col),1,Cols-2,Wattr);
  139.         HiLiteLetter (Menu,HiLiteLine);
  140.         Qattr (Row+HLnew,succ(Col),1,Cols-2,Hattr);
  141.         HiLiteLine:=HLnew;
  142.       end;
  143. end;
  144.  
  145. procedure ShowMenu (VAR Menu: MenuRec);
  146. var
  147.   R,C,Attrib:   integer;
  148.   Symbol:       string[1];
  149.   PartitionStr: string[3];
  150. begin
  151.   with Menu do
  152.   begin
  153.     MakeWindow (Row,Col,Rows,Cols,Wattr,Battr,Border);
  154.     for i:=1 to MenuLines do
  155.       begin
  156.         R:=Row+i;
  157.         if LineMode[i]=Partition then
  158.           begin
  159.             case LinkNum[i] of
  160.               11: PartitionStr:='├─┤';
  161.               12: PartitionStr:='╞═╡';
  162.               21: PartitionStr:='╟─╢';
  163.               22: PartitionStr:='╠═╣';
  164.             else with Brdr[Border] do PartitionStr:=LV+BH+RV;
  165.             end;  { case }
  166.             Qwrite (R,Col,                  -1,PartitionStr[1]);
  167.             Qwrite (R,pred(Col)+Cols,       -1,PartitionStr[3]);
  168.             Qfill  (R,succ(Col),1,Cols-2,Battr,PartitionStr[2])
  169.           end
  170.         else
  171.           begin
  172.             if LineMode[i]=Comment then
  173.                  Attrib:=Cattr
  174.             else Attrib:=-1;
  175.             if Flagged[i] then Qwrite (R,Col+2,Attrib,#16);
  176.             QwriteV (R,Col+4,Attrib,Line[i]);
  177.             if LineMode[i]<>Comment then HiLiteLetter(Menu,i);
  178.             case LineMode[i] of ToDataWndw..ToUserWndw:
  179.               begin
  180.                 if LinkDir=Left then
  181.                      C:=succ(Col)
  182.                 else C:=Col+Cols-2;
  183.                 if LineMode[i]=ToDataWndw then
  184.                      Symbol:=#250
  185.                 else Symbol:=#240;
  186.                 QwriteV (R,C,-1,Symbol);
  187.               end;
  188.             end   { case }
  189.           end
  190.       end;   { for i }
  191.     if BackToDefault then HiLiteLine:=DefaultLine;
  192.     Qattr (Row+HiLiteLine,succ(Col),1,Cols-2,Hattr);
  193.   end
  194. end;
  195.  
  196. procedure RollHiLite (VAR Menu: MenuRec; Dir: DirType);
  197. var HLnew: integer;
  198. begin
  199.   with Menu do
  200.   begin
  201.     HLnew:=HiLiteLine;
  202.     repeat
  203.       case Dir of
  204.         Up:     if HLnew=1 then
  205.                      HLnew:=MenuLines
  206.                 else HLnew:=pred(HLnew);
  207.         Down:   if HLnew=MenuLines then
  208.                      HLnew:=1
  209.                 else HLnew:=succ(HLnew);
  210.         Top:    begin
  211.                   HLnew:=1;
  212.                   Dir:=Down
  213.                 end;
  214.         Bottom: begin
  215.                   HLnew:=MenuLines;
  216.                   Dir:=Up
  217.                 end;
  218.       end;  { case }
  219.     until (LineMode[HLnew]<>Comment) and (LineMode[HLnew]<>Partition);
  220.     MoveHiLite (Menu,HLnew);
  221.   end
  222. end;
  223.  
  224. procedure ShowTopMenu;
  225. begin
  226.   QwriteV (TopMenuRow,1,TopMenuAttr,TopMenuStr);
  227.   for i:=1 to LastMainMenu do
  228.     Qattr (TopMenuRow,succ(MainMenu[i].NameCol),1,1,TopMenuLattr);
  229. end;
  230.  
  231. procedure ShowTopHiLite;
  232. begin
  233.   with MainMenu[MPulled] do
  234.     Qattr (TopMenuRow,NameCol,1,ord(Title[0])+2,TopMenuHattr);
  235. end;
  236.  
  237. procedure MoveTopHiLite (MPnew: integer);
  238. begin
  239.   if MPnew<>MPulled then
  240.     begin
  241.       MPulled:=MPnew;
  242.       ShowTopMenu;
  243.       ShowTopHiLite;
  244.     end;
  245. end;
  246.  
  247. procedure RollMenu (Dir: DirType);
  248. var MPnew: integer;
  249. begin
  250.   MPnew:=MPulled;
  251.   case Dir of
  252.     Left:     if MPnew=1 then
  253.                    MPnew:=LastMainMenu
  254.               else MPnew:=pred(MPnew);
  255.     Right:    if MPnew=LastMainMenu then
  256.                    MPnew:=1
  257.               else MPnew:=succ(MPnew);
  258.     FarLeft:  MPnew:=1;
  259.     FarRight: MPnew:=LastMainMenu;
  260.   end;
  261.   if MPnew<>MPulled then
  262.     begin
  263.       RemoveWindow;
  264.       MoveTopHiLite (MPnew);
  265.       ShowMenu (MainMenu[MPulled]);
  266.       ShowMsg (MainMenu[MPulled].MsgLineNum);
  267.       CmdSeq:=TopCmdLtrs[MPulled];
  268.     end;
  269. end;
  270.  
  271. procedure DoChoice (VAR Menu: MenuRec; VAR TF: boolean);
  272. type  Str1 = string[1];
  273. var   Flag: Str1;
  274. {}procedure ShowFlag (LineNum: integer; Flag: Str1);
  275.   begin
  276.     with Menu do
  277.       QwriteV (Row+LineNum,Col+2,-1,Flag)
  278. {}end;
  279. begin
  280.   with Menu do
  281.     begin
  282.       if MenuMode<=ExecMultipleChoice then
  283.         Process (MPulled,SPulled,HiLited);
  284.       case MenuMode of
  285.         SingleChoice,ExecSingleChoice:
  286.           if TF=false then
  287.             begin
  288.               Flagged[SingleFlagLine] := false;
  289.               TF := true;
  290.               ShowFlag (SingleFlagLine,' ');
  291.               SingleFlagLine := HiLited;
  292.               ShowFlag (HiLited,^P);
  293.               Changed := true;
  294.             end;
  295.         MultipleChoice,ExecMultipleChoice:
  296.           begin
  297.             TF := TF xor true;
  298.             if TF then
  299.                  Flag:=^P
  300.             else Flag:=' ';
  301.             ShowFlag (HiLited,Flag);
  302.             Changed := true;
  303.           end;
  304.       end; { case }
  305.   end    { with }
  306. end;
  307.  
  308. {$V-}
  309. procedure TempMsg (Switch: Toggle; VAR Msg: MaxString);
  310. var Row,L: integer;
  311. begin
  312.   Row := CRTrows-RowsBelowMsg;
  313.   case Switch of
  314.     On: begin
  315.           QstoreToMem (Row,1,1,MaxStringLength shl 1,TempMsgArray);
  316.           QwriteV (Row,1,MsgLineAttr,Msg);
  317.           L := length (Msg);
  318.           Qfill (Row,succ(L),1,CRTcols-L,-1,' ');
  319.         end;
  320.     Off:  QstoreToScr (Row,1,1,MaxStringLength shl 1,TempMsgArray);
  321.   end
  322. end;
  323.  
  324. procedure ShowErrorMsg (ErrMsgNum: integer);
  325. var Row,L: integer;
  326. begin
  327.   TempMsg (On,ErrMsgLine[ErrMsgNum]);
  328.   repeat
  329.     sound (100);
  330.     delay (30);
  331.     nosound;
  332.     ReadKB (ExtKey,Key);
  333.   until Key=EscKey;
  334.   Key:=' ';
  335.   TempMsg (Off,ErrMsgLine[1]);
  336. end;
  337. {$V+}
  338.  
  339. function TopKeyPressed: boolean;
  340. begin
  341.   if (ExtKey and (Key=TopKey1)) or (not ExtKey and (Key=TopKey2)) then
  342.        TopKeyPressed:=true
  343.   else TopKeyPressed:=false
  344. end;
  345.  
  346. function HelpKeyPressed: boolean;
  347. begin
  348.   if ExtKey and (Key=HelpKey) then
  349.        HelpKeyPressed:=true
  350.   else HelpKeyPressed:=false  { F1 key }
  351. end;
  352.  
  353. procedure PullHelpWndw (WndwNum: integer; Title: MaxString);
  354. var  OldCursor: integer;
  355. begin
  356.   CursorChange (HideCursor,OldCursor);
  357.   with HelpWndw[WndwNum] do
  358.     begin
  359.       ZoomEffect:=HelpZoom;
  360.       ShadowEffect:=HelpShadow;
  361.       TempMsg (On,MsgLine[MsgLineNum]);
  362.       MakeWindow (Row,Col,Rows,Cols,Wattr,Battr,Border);
  363.       if Title<>'' then
  364.         TitleWindow (Center,' Help for "'+Title+'" ');
  365.       for i:=FirstLine to pred(FirstLine+LinesToShow) do
  366.         QwriteV (succ(Row)+i-FirstLine,Col+2,-1,HelpLine[i]);
  367.     end;
  368.   repeat
  369.     ReadKB (ExtKey,Key);
  370.     if HelpKeyPressed then Key:=EscKey;   { Help key -> ESC key }
  371.   until Key=EscKey;
  372.   Key:=' ';
  373.   RemoveWindow;
  374.   ZoomEffect:=false;
  375.   ShadowEffect:=NoDir;
  376.   TempMsg (Off,MsgLine[1]);
  377.   CursorChange (OldCursor,OldCursor);
  378. end;
  379.  
  380. procedure TurnArrows (Switch: Toggle; VAR Menu: MenuRec);
  381. var Arrow: string[1];
  382.     R: integer;
  383. begin
  384.   with Menu do
  385.     begin
  386.       R:=Row+HiLiteLine;
  387.       if Switch=Off then Arrow:=' '
  388.       else
  389.         case LinkDir of
  390.           Left:  Arrow:='<';
  391.           Right: Arrow:='>';
  392.         end;
  393.       QwriteV (R,Col+2     ,-1,Arrow);
  394.       QwriteV (R,Col+Cols-3,-1,Arrow);
  395.     end
  396. end;
  397.  
  398. procedure CheckForPull;
  399. begin
  400.   if Pull then
  401.     begin
  402.       if MoreCmdSeq='' then Pull:=false
  403.       else
  404.         begin
  405.           Key:=MoreCmdSeq[1];
  406.           MoreCmdSeq[0]:=pred(MoreCmdSeq[0]);
  407.           { Delete the first character }
  408.           Move (MoreCmdSeq[2],MoreCmdSeq[1],ord(MoreCmdSeq[0]));
  409.         end;
  410.       ExtKey:=false
  411.     end
  412. end;
  413.  
  414. procedure CheckForPop;
  415. begin
  416.   if PopToWorkWndw and not Pop then MoreCmdSeq:=CmdSeq;
  417.   if PopToWorkWndw or PopToTop or (PopLevels>0) then
  418.        Pop:=true
  419.   else Pop:=false;
  420.   if PopLevels>0 then PopLevels:=pred(PopLevels)
  421. end;
  422.  
  423. function Popped: boolean;
  424. begin
  425.   if InWorkWndw then Popped:=true
  426.   else
  427.     begin
  428.       OldMPulled:=MPulled;
  429.       OldSPulled:=SPulled;
  430.       OldHiLited:=HiLited;
  431.       PopToWorkWndw:=true;
  432.       PopAndProcess:=true;
  433.       Popped:=false
  434.     end
  435. end;
  436.  
  437. procedure PullSubMenu (VAR Menu: MenuRec; MenuNum: integer); forward;
  438.  
  439. procedure CheckSelection (VAR Menu: MenuRec);
  440. var Position: integer;
  441. begin
  442.   if TopKeyPressed then PopToTop:=true
  443.   else
  444.   with Menu do
  445.   begin
  446.     Position := pos (upcase(Key),CmdLtrs);
  447.     if Position<>0 then
  448.       begin
  449.         MoveHiLite(Menu,Position);
  450.         Key:=RetKey
  451.       end;
  452.     if Key=RetKey then
  453.       begin
  454.         HiLited:=HiLiteLine;
  455.         case LineMode[HiLited] of
  456.           Choice:     DoChoice     (Menu,Flagged[HiLited]);
  457.           ExecOnly:   Process      (MPulled,Spulled,HiLited);
  458.           ToDataWndw: PullDataWndw (Menu,LinkNum[HiLited]);
  459.           ToSubMenu:  PullSubMenu  (Menu,LinkNum[HiLited]);
  460.           ToUserWndw: PullUserWndw (Menu,LinkNum[HiLited]);
  461.         end
  462.       end
  463.   end  { with }
  464. end;
  465.  
  466. procedure PullSubMenu;  { (VAR Menu: MenuRec; MenuNum: integer) }
  467. begin
  468.   SPulled:=MenuNum;
  469.   with Menu do
  470.     CmdSeq:=CmdSeq+CmdLtrs[HiLiteLine];
  471.   TurnArrows (On,Menu);
  472.   ShowMenu (SubMenu[MenuNum]);
  473.   repeat
  474.     with SubMenu[MenuNum] do
  475.     begin
  476.       CheckForPull;
  477.       if not Pull then
  478.         begin
  479.           ShowMsg (MsgLineNum);
  480.           ReadKB (ExtKey,Key)
  481.         end;
  482.       if ExtKey then
  483.         case Key of
  484.           #72:     RollHiLite (SubMenu[MenuNum],Up    );  { Up   arrow }
  485.           #80:     RollHiLite (SubMenu[MenuNum],Down  );  { Down arrow }
  486.           #71,#73: RollHiLite (SubMenu[MenuNum],Top   );  { Home and PgUp }
  487.           #79,#81: RollHiLite (SubMenu[MenuNum],Bottom);  { End  and PgDn }
  488.           HelpKey: PullHelpWndw (HelpWndwNum,Title);      { F1 }
  489.           PopKey:  PopToWorkWndw:=true;                   { F2 }
  490.           TopKey1: PopToTop:=true;                        { F10 }
  491.         end      { end case }
  492.       else  CheckSelection (SubMenu[MenuNum]);
  493.       CheckForPop
  494.     end;  { with }
  495.   until (Key=EscKey) or Pop;
  496.   Key:=' ';
  497.   RemoveWindow;
  498.   CmdSeq[0]:=pred(CmdSeq[0]);
  499.   TurnArrows (Off,Menu);
  500.   if not Pop then ShowMsg (Menu.MsgLineNum)
  501. end;
  502.  
  503. procedure PullMainMenu;
  504. begin
  505.   SPulled:=0;
  506.   CmdSeq:=TopCmdLtrs[MPulled];
  507.   ShowMenu (MainMenu[MPulled]);
  508.   repeat
  509.     with MainMenu[MPulled] do
  510.     begin
  511.       CheckForPull;
  512.       if not Pull then
  513.         begin
  514.           ShowMsg (MsgLineNum);
  515.           ReadKB (ExtKey,Key)
  516.         end;
  517.       if ExtKey then
  518.         case Key of
  519.           #72:      RollHiLite (MainMenu[MPulled],Up      );  { Up   arrow }
  520.           #80:      RollHiLite (MainMenu[MPulled],Down    );  { Down arrow }
  521.           #71,#73:  RollHiLite (MainMenu[MPulled],Top     );  { Home & PgUp }
  522.           #79,#81:  RollHiLite (MainMenu[MPulled],Bottom  );  { End  & PgDn }
  523.           #75:      RollMenu   (                  Left    );  { Left  arrow }
  524.           #77:      RollMenu   (                  Right   );  { Right arrow }
  525.           #119,#115:RollMenu   (                  FarLeft );  { ^Home & ^Left }
  526.           #117,#116:RollMenu   (                  FarRight);  { ^End & ^Right }
  527.           HelpKey:  PullHelpWndw (HelpWndwNum,Title);         { F1 }
  528.           PopKey:   PopToWorkWndw:=true;                      { F2 }
  529.           TopKey1:  PopToTop:=true;                           { F10 }
  530.         end      { end case }
  531.       else
  532.         begin
  533.           CheckSelection (MainMenu[MPulled]);
  534.           SPulled:=0
  535.         end;
  536.       CheckForPop
  537.     end;  { with }
  538.   until (Key=EscKey) or Pop;
  539.   Key := ' ';
  540.   RemoveWindow;
  541.   CmdSeq[0] := char(0);
  542.   if not Pop then ShowMsg (2)
  543. end;
  544.  
  545. procedure PullTopMenu;
  546. var  Position, MPnew: integer;
  547. begin
  548.   ShowTopHiLite;
  549.   repeat
  550.     CheckForPull;
  551.     if not Pull then
  552.       begin
  553.         ShowMsg (2);
  554.         ReadKB (ExtKey,Key)
  555.       end;
  556.     MPnew:=MPulled;
  557.     if ExtKey then
  558.       begin
  559.         case Key of
  560.           #75:      if MPulled=1 then                { Left  arrow }
  561.                          MPnew:=LastMainMenu
  562.                     else MPnew:=pred(MPulled);
  563.           #77:      if MPulled=LastMainMenu then     { Right arrow }
  564.                          MPnew:=1
  565.                     else MPnew:=succ(MPulled);
  566.           #71,#119,#115,#73: MPnew:=1;               { Home,^Home,^Left,PgUp }
  567.           #79,#117,#116,#81: MPnew:=LastMainMenu;    { End, ^End,^Right,PgDn }
  568.           HelpKey:  PullHelpWndw (2,'Top Menu');     { F1 }
  569.           PopKey:   PopToWorkWndw:=true;             { F2 }
  570.         end;
  571.         MoveTopHiLite (MPnew);
  572.       end
  573.     else
  574.       begin
  575.         Position := pos (upcase(Key),TopCmdLtrs);
  576.         if Position<>0 then
  577.           begin
  578.             MPnew:=Position;
  579.             Key:=RetKey
  580.           end;
  581.         if Key=RetKey then
  582.           begin
  583.             MoveTopHiLite (MPnew);
  584.             PullMainMenu;
  585.             PopToTop:=false;
  586.           end
  587.       end;
  588.     CheckForPop;
  589.   until (Key=EscKey) or Pop;
  590.   ShowTopMenu;
  591. end;
  592.  
  593. procedure GotoMenus;
  594. begin
  595.   InWorkWndw:=false;
  596.   CursorOff;
  597.   CmdSeq[0]:=char(0);
  598.   if TopKeyPressed then
  599.     begin
  600.       Pull:=false;
  601.       MoreCmdSeq[0]:=char(0);
  602.     end;
  603.   PullTopMenu;
  604.   InWorkWndw:=true;
  605.   if PopAndProcess then Process (OldMPulled,OldSPulled,OldHiLited);
  606.   CursorOn;
  607. end;
  608.  
  609. procedure GotoWorkWndw;
  610. begin
  611.   repeat
  612.     WorkWndw;
  613.     if ExtKey then
  614.       case Key of
  615.         PopKey,TopKey1:  Pull:=true;
  616.       end
  617.     else
  618.       case Key of
  619.         EscKey,TopKey2:  Pull:=true;
  620.       end;
  621.   until Pull or Quit;
  622. end;
  623.  
  624. procedure ClearPopFlags;
  625. begin
  626.   PopToWorkWndw := false;
  627.   PopToTop      := false;
  628.   PopLevels     := 0;
  629.   Pop           := false;
  630.   PopAndProcess := false;
  631. end;
  632.  
  633. procedure GotoKeyDispatcher;
  634. begin
  635.   repeat
  636.     ClearPopFlags;
  637.     if Pull then
  638.          GotoMenus
  639.     else GotoWorkWndw;
  640.   until Quit
  641. end;
  642.  
  643. { ALL of the remaining procedures could be made overlays; they are used once
  644.   for initialization and never used again. }
  645.  
  646. procedure CheckCursor;
  647. var CursorMode: integer absolute $0000:$0460;
  648. begin
  649.   if ActiveDD=MdaMono then
  650.     if CursorMode=$0607 then   { Some BIOS set the wrong default! }
  651.       CursorChange ($0B0C,i);
  652. end;
  653.  
  654. procedure InitMenuSize;
  655. var Lmax,L,L2: integer;
  656. {}procedure GetRowsAndCols (VAR Menu: MenuRec);
  657.   var CmdLtr: char;
  658.   begin
  659.     with Menu do
  660.       begin
  661.         Rows := MenuLines+2;
  662.         Lmax := 0;
  663.         CmdLtrs[0] := char(0);
  664.         for j:=1 to MenuLines do
  665.           begin
  666.             L := ord(Line[j][0]);
  667.             if L>Lmax then Lmax:=L;
  668.             case LineMode[j] of
  669.               Comment,Partition: CmdLtr:=#00; { #00 - for inaccessible lines. }
  670.             else CmdLtr:=upcase(Line[j][1]);
  671.             end;  { case }
  672.             CmdLtrs := CmdLtrs+CmdLtr;
  673.           end;
  674.         Cols:= Lmax+8
  675.       end
  676. {}end;  { procedure }
  677. {}procedure SetMenuDefaults (VAR Menu: MenuRec; MenuBrdr: Borders);
  678.   begin
  679.     with Menu do
  680.       begin
  681.         GetRowsAndCols (Menu);
  682.         Border := MenuBrdr;
  683.         HiLiteLine := DefaultLine;
  684.         case MenuMode of
  685.           SingleChoice,ExecSingleChoice: Flagged[SingleFlagLine]:=true;
  686.         end;
  687.       end;
  688. {}end;  { procedure }
  689. begin
  690.   for i:=1 to NumOfMainMenus do SetMenuDefaults (MainMenu[i],MainMenuBrdr);
  691.   for i:=1 to NumOfSubMenus  do SetMenuDefaults (SubMenu[i] ,SubMenuBrdr);
  692.   for i:=1 to NumOfHelpWndws do
  693.     begin
  694.       with HelpWndw[i] do
  695.         begin
  696.           Rows   := LastLine-FirstLine+3;
  697.           Cols   := HelpCharsPerLine+4;
  698.           Border := HelpWndwBrdr;
  699.           Zoom   := HelpZoom;
  700.           LinesToShow:=succ(LastLine-FirstLine);
  701.        end
  702.     end
  703. end;
  704.  
  705. procedure InitMenuColor;
  706. begin
  707.   for i:=1 to NumOfMainMenus do
  708.     with MainMenu[i] do
  709.       begin
  710.         Hattr := MainMenuHattr;
  711.         Wattr := MainMenuWattr;
  712.         Battr := MainMenuBattr;
  713.         Lattr := MainMenuLattr;
  714.         Cattr := MainMenuCattr;
  715.       end;
  716.   for i:=1 to NumOfSubMenus do
  717.     with SubMenu[i] do
  718.       begin
  719.         Hattr := SubMenuHattr;
  720.         Wattr := SubMenuWattr;
  721.         Battr := SubMenuBattr;
  722.         Lattr := SubMenuLattr;
  723.         Cattr := SubMenuCattr;
  724.       end;
  725.   for i:=1 to NumOfHelpWndws do
  726.     with HelpWndw[i] do
  727.       begin
  728.         Wattr      := HelpWndwWattr;
  729.         Battr      := HelpWndwBattr;
  730.         Shadow     := HelpShadow;
  731.         MsgLineNum := HelpMsgLineNum;
  732.       end;
  733. end;
  734.  
  735. procedure LocateMainMenus;
  736. begin
  737.   fillchar (TopMenuStr,succ(CRTcols),' ');
  738.   TopMenuStr:=' ≡';
  739.   TopCmdLtrs[0]:=char(0);
  740.   for i:=1 to NumOfMainMenus do
  741.     with MainMenu[i] do
  742.       begin
  743.         Row := MainMenuRow;
  744.         Col := succ(ord(TopMenuStr[0]));
  745.         NameCol := succ(Col);
  746.         TopMenuStr := TopMenuStr + '  ' + Title;
  747.         TopCmdLtrs := TopCmdLtrs + upcase(Title[1]);
  748.         if Cols+Col>pred(CRTcols) then Col:=pred(CRTcols-Cols);
  749.       end;
  750.   TopMenuStr[0] := char(CRTcols)
  751. end;
  752.  
  753. procedure LocateSubMenus;   { and DataWndws }
  754. var RoomL,RoomR,RoomMax,TestWidth,QtyL,QtyR: integer;
  755. {}procedure FindLinkDir (VAR Menu: MenuRec);
  756.   begin
  757.     with Menu do
  758.     begin
  759.       RoomL := Col;
  760.       RoomR := CRTcols-(pred(Col)+Cols);
  761.       if RoomR>=RoomL then RoomMax:=RoomR else RoomMax:=RoomL;
  762.       QtyL:=0; QtyR:=0;
  763.       for j:=1 to MenuLines do
  764.         case LineMode[j] of ToDataWndw,ToSubMenu:
  765.           begin
  766.             case LineMode[j] of
  767.               ToSubMenu:  TestWidth:=SubMenu[LinkNum[j]].Cols;
  768.               ToDataWndw: TestWidth:=DataWndw[LinkNum[j]].Cols;
  769.             end;
  770.             if TestWidth<=RoomMax then
  771.               begin
  772.                 if TestWidth<=RoomR then QtyR:=succ(QtyR);
  773.                 if TestWidth<=RoomL then QtyL:=succ(QtyL);
  774.               end
  775.             else if (LineMode[j]=ToSubMenu) and LocationWarning then
  776.                     writeln ('No room for SubMenu[',j,']',^G^G);
  777.           end
  778.         end;  { case LineMode }
  779.       if QtyR>=QtyL then LinkDir:=Right else LinkDir:=Left;
  780.     end { with }
  781. {}end; { procedure }
  782. {}procedure AssignLocations (VAR Menu: MenuRec);
  783.   begin
  784.     with Menu do
  785.       for j:=1 to MenuLines do
  786.         case LineMode[j] of
  787.           ToSubMenu:
  788.             with SubMenu[LinkNum[j]] do
  789.               begin
  790.                 case Menu.LinkDir of
  791.                   Right: Col:=Menu.Col+(Menu.Cols-2);
  792.                   Left:  Col:=Menu.Col-(Cols-2);
  793.                 end;
  794.                 Row:=Menu.Row+j;
  795.                 if (Row+Rows)>CRTrows-2 then Row:=pred(CRTrows-Rows);
  796.                 Title:=Menu.Line[j]
  797.               end;
  798.           ToDataWndw:
  799.             begin
  800.               case LinkDir of
  801.                 Right: RoomMax:=CRTcols-(pred(Col)+Cols);
  802.                 Left:  RoomMax:=Col;
  803.               end;
  804.               with DataWndw[LinkNum[j]] do
  805.                 if Cols>RoomMax then
  806.                   begin
  807.                     RowAlt := succ((CRTrows-Rows) shr 1);
  808.                     ColAlt := succ((CRTcols-Cols) shr 1)
  809.                   end;
  810.             end
  811.         end    { case }
  812. {}end; { procedure }
  813. begin
  814.   for i:=1 to NumOfMainMenus do FindLinkDir (MainMenu[i]);
  815.   for i:=1 to NumOfMainMenus do AssignLocations (MainMenu[i]);
  816.   for i:=1 to NumOfSubMenus  do FindLinkDir (SubMenu[i]);
  817.   for i:=1 to NumOfSubMenus  do AssignLocations (SubMenu[i]);
  818. end;
  819.  
  820. procedure LocateHelpWndws;
  821. begin
  822.   for i:=1 to NumOfHelpWndws do
  823.     with HelpWndw[i] do
  824.       begin
  825.         Row := succ(CRTrows-Rows-RowsBelowHelp);
  826.         Col := succ((CRTcols-Cols) shr 1);
  827.       end
  828. end;
  829.  
  830. procedure ClearPullStats;
  831. begin
  832.  fillchar (MainMenu,SizeOf(MainMenu),0);
  833.  fillchar (SubMenu ,SizeOf(SubMenu) ,0);
  834.  fillchar (DataWndw,SizeOf(DataWndw),0);
  835.  fillchar (HelpWndw,SizeOf(HelpWndw),0)
  836. end;
  837.  
  838. procedure InitPull (Attrib: integer);
  839. begin
  840.   InitAttr:=Attrib;
  841.   InitWindow (InitAttr);
  842.   CheckCursor;
  843.     CRTcols:=CRTcolumns;
  844.     InWorkWndw:=true;
  845.     Quit:=false;
  846.   ClearPullStats;
  847.   GetUserPullStats;
  848.   InitMenuSize;
  849.   InitMenuColor;
  850.   InitDataWndwSize;
  851.   InitDataWndwColor;
  852.   LocateMainMenus;
  853.   LocateSubMenus;
  854.   LocateHelpWndws;
  855.   GetOverrideStats
  856. end;