home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / progmisc / tttsrc51.zip / NESTTTT5.PAS < prev    next >
Pascal/Delphi Source File  |  1993-03-08  |  40KB  |  1,078 lines
  1. {--------------------------------------------------------------------------}
  2. {                         TechnoJock's Turbo Toolkit                       }
  3. {                                                                          }
  4. {                              Version   5.10                              }
  5. {                                                                          }
  6. {                                                                          }
  7. {               Copyright 1986-1993 TechnoJock Software, Inc.              }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.  
  12.                      {--------------------------------}
  13.                      {       Unit:  NestTTT5          }
  14.                      {--------------------------------}
  15.  
  16. {Revision History:    2/13/89    5.00a corrected calculation of Y2 lines
  17.                                  542 and 544. (thanks Mike!)
  18.                                  5.01a  removed refrences to VER50 and
  19.                                         added DEBUG compiler directive
  20.                      01/04/93    5.10   DPMI compatible version
  21.                      02/09/93    5.10a  Corrected ClearAll for Protected Mode
  22. }
  23.  
  24.  
  25. {$S-,R-,V-}       
  26. {$IFNDEF DEBUG}
  27. {$D-}
  28. {$ENDIF}
  29.  
  30. Unit NestTTT5;
  31.  
  32. INTERFACE
  33.  
  34. Uses CRT, FastTTT5, DOS, WinTTT5, KeyTTT5, StrnTTT5;
  35.  
  36. CONST
  37.    Max_Levels = 10;        {maximum number of nested menus - alter if necessary}
  38.    MenuStrLength = 40;     {maximum length of a menu topic - alter if necessary}
  39.    DontClear    = 0;       {signal to return to same position in menu}
  40.    RefreshTopic = 1;       {signal to rewrite highlighted topic}
  41.    RefreshMenu  = 2;       {signal to reload current menu}
  42.    ClearCurrent = 3;       {signal to remove current menu}
  43.    ClearAll     = 4;       {signal to remove all menus}
  44.    Undefined    = 99;      {despatcher has not been assigned}
  45.  
  46. Type
  47.    {$IFNDEF VER40}
  48.    Nest_Key_Proc =   procedure(var Ch:char; Code:Integer);
  49.    Despatcher_Proc = procedure(Var Code: integer; var Finish:byte);
  50.    {$ENDIF}
  51.  
  52.    MenuStr = string[MenuStrLength];
  53.  
  54.    N_Display = record
  55.                      X           : byte;     {top X coord}
  56.                      Y           : byte;     {top Y coord}
  57.                      LeftSide    : boolean;  {does menu start on left or right}
  58.                      AllowEsc    : boolean;  {can user escape from the top level}
  59.                      BoxType     : byte;     {single,double etc}
  60.                      BoxFCol     : byte;     {Border foreground color}
  61.                      BoxBCol     : byte;     {Border background color}
  62.                      CapFCol     : byte;     {Capital letter foreground color}
  63.                      BacCol      : byte;     {menu background color}
  64.                      NorFCol     : byte;     {normal foreground color}
  65.                      LoFCol      : byte;     {inactive topic foreground color}
  66.                      HiFCol      : byte;     {highlighted topic foreground color}
  67.                      HiBCol      : byte;     {highlighted topic background color}
  68.                      LeftChar    : char;     {left-hand topic highlight character}
  69.                      RightChar   : char;     {right-hand topic highlight character}
  70.                      {$IFNDEF VER40}
  71.                      Hook        : Nest_Key_Proc;   { a procedure called after every key is pressed}
  72.                      Despatcher  : Despatcher_proc;     { the main procedure to execute}
  73.                      {$ENDIF}
  74.                end;
  75.  
  76.     TopicPtr    = ^TopicRecord;
  77.  
  78.     MenuPtr     = ^Nest_Menu;
  79.  
  80.     TopicRecord = record
  81.                         Name : MenuStr;
  82.                         Active: boolean;
  83.                         HotKey : char;
  84.                         RetCode : integer;
  85.                         Sub_Menu: MenuPtr;
  86.                         Next_Topic: TopicPtr;
  87.                    end;
  88.  
  89.     Nest_Menu  = record
  90.                         Title: MenuStr;          {title for menu}
  91.                         Topic_Width: byte;       {width of topics in menu}
  92.                         Visible_Lines : word;    {no. topics in box, 0 is DisplayLines - 2}
  93.                         First_Topic : TopicPtr;      {used internally, do not alter}
  94.                         Total_Topics: word;          {used internally, do not alter}
  95.                    end;
  96.  
  97.   VAR
  98.     {$IFDEF VER40}
  99.     Nest_UserHook : pointer;
  100.     Nest_Despatcher: pointer;
  101.     {$ENDIF}
  102.     N_fatal : Boolean;
  103.     N_Error : Integer;
  104.     NTTT    : N_Display;
  105.  
  106.   Procedure Default_Settings;
  107.   {$IFNDEF VER40}
  108.   Procedure Assign_Despatcher(D:Despatcher_Proc);
  109.   {$ENDIF}
  110.  
  111.   Procedure Initialize_Menu(var Menu:Nest_Menu;
  112.                                 Tit: menuStr;
  113.                                 Width: byte;
  114.                                 Display_Lines: word);
  115.  
  116.   Procedure Add_Topic(var Menu:Nest_Menu;
  117.                           Nam : MenuStr;
  118.                           Activ : boolean;
  119.                           HKey : char;
  120.                           Code : integer;
  121.                           Sub: MenuPtr);
  122.  
  123.   Procedure Modify_Topic(var Menu:Nest_Menu;
  124.                              TopicNo : word;
  125.                              Nam : MenuStr;
  126.                              Activ : boolean;
  127.                              HKey  : char;
  128.                              Code : integer;
  129.                              Sub: MenuPtr);
  130.  
  131.   Procedure Modify_Topic_Name(var Menu:Nest_Menu;
  132.                                   TopicNo : word;
  133.                                   Nam : MenuStr);
  134.  
  135.   Procedure Modify_Topic_Active(var Menu:Nest_Menu;
  136.                                   TopicNo : word;
  137.                                   Activ : Boolean);
  138.  
  139.   Procedure Modify_Topic_HotKey(var Menu:Nest_Menu;
  140.                                     TopicNo : word;
  141.                                     HKey : char);
  142.  
  143.   Procedure Modify_Topic_RetCode(var Menu:Nest_Menu;
  144.                                      TopicNo : word;
  145.                                      Code : integer);
  146.  
  147.   Procedure Modify_Topic_SubMenu(var Menu:Nest_Menu;
  148.                                      TopicNo : word;
  149.                                      Sub : MenuPtr);
  150.  
  151.   Procedure Delete_A_Topic(var Menu:Nest_Menu;TopicNo: word);
  152.  
  153.   Procedure Delete_All_Topics(var Menu:Nest_Menu);
  154.  
  155.   Procedure Show_Nest(var Menu:Nest_Menu);
  156.  
  157. IMPLEMENTATION
  158. var
  159.   Despatcher_Assigned : boolean;
  160.  
  161.   Procedure NestTTT_Error(No : byte);
  162.   {Updates N_error and optionally displays error message then halts program}
  163.   var Msg : String;
  164.   begin
  165.       N_error := No;
  166.       If N_fatal = true then
  167.       begin
  168.           Case No of
  169.           1 :  Msg := 'Insufficient memory to add topic';
  170.           2 :  Msg := 'Insufficient memory to save screen';
  171.           3 :  Msg := 'No active picks in menu';
  172.           4 :  Msg := 'Screen was not previously saved cannot restore';
  173.           5 :  Msg := 'Too many levels in menu. Change Max_Levels in NestTTT';
  174.           6 :  Msg := 'Topic does not exist, cannot modify';
  175.           7 :  Msg := 'A user procedure has not been assigned to despatcher';
  176.           else Msg := '?) -- Utterly confused';
  177.           end; {Case}
  178.           Msg := 'Fatal Error (NestTTT -- '+Msg;
  179.           Writeln(Msg);
  180.           Delay(5000);    {display long enough to read if child process}
  181.           Halt;
  182.       end;
  183.   end;
  184.  
  185. {$F+}
  186.   Procedure Empty_Despatcher(Var Code: integer; var Finish:byte);
  187.   {}
  188.   begin
  189.       Finish := Undefined;
  190.   end; {of proc Empty_Despatcher}
  191.  
  192.   Procedure No_Nest_Hook(var Ch : char; Code: Integer);
  193.   {}
  194.   begin
  195.   end; {of proc No_Nest_Hook}
  196. {$F-}
  197.  
  198.    {$IFDEF VER40}
  199.    Procedure CallFromNestUserHook(var Ch:char; code:integer);
  200.           Inline($FF/$1E/Nest_UserHook);
  201.  
  202.    Procedure CallFromNestDespatcher(Var Code: integer; var Finish:byte);
  203.           Inline($FF/$1E/Nest_Despatcher);
  204.    {$ENDIF}
  205.  
  206.   Procedure Default_Settings;
  207.   begin
  208.       with NTTT do
  209.       begin
  210.           X := 0;
  211.           Y := 0;
  212.           Despatcher_Assigned := false;
  213.           LeftSide     := true;
  214.           AllowEsc := true;
  215.           BoxType      := 1;
  216.           If ColorScreen then
  217.           begin
  218.               BoxFCol      := yellow;
  219.               BoxBCol      := blue;
  220.               CapFCol      := White;
  221.               BacCol       := blue;
  222.               NorFCol      := lightgray;
  223.               LoFCol       := black;
  224.               HiFCol       := white;
  225.               HiBCol       := red;
  226.           end
  227.           else
  228.           begin
  229.               BoxFCol      := white;
  230.               BoxBCol      := black;
  231.               CapFCol      := White;
  232.               BacCol       := black;
  233.               NorFCol      := lightgray;
  234.               LoFCol       := darkgray;
  235.               HiFCol       := white;
  236.               HiBCol       := black;
  237.           end;
  238.           LeftChar     := Chr(16);
  239.           RightChar    := Chr(17);
  240.           {$IFNDEF VER40}
  241.           Hook := No_Nest_Hook;
  242.           Despatcher   := Empty_Despatcher;
  243.           {$ELSE}
  244.            Nest_UserHook := nil;
  245.            Nest_Despatcher:= nil;
  246.           {$ENDIF}
  247.       end;  {with}
  248.   end;  {Default_Settings}
  249.  
  250.   {$IFNDEF VER40}
  251.   Procedure Assign_Despatcher(D:Despatcher_Proc);
  252.   begin
  253.       NTTT.Despatcher := D;
  254.       Despatcher_Assigned := true;
  255.   end;
  256.   {$ENDIF}
  257.  
  258.   Procedure Initialize_Menu(var Menu:Nest_Menu;
  259.                                 Tit: menuStr;
  260.                                 Width: byte;
  261.                                 Display_Lines: word);
  262.   {}
  263.   begin
  264.       With Menu do
  265.       begin
  266.           Title         := Tit;
  267.           Topic_Width   := Width;
  268.           Visible_Lines := Display_Lines;
  269.           First_Topic   := nil;
  270.           Total_Topics  := 0;
  271.       end; {with}
  272.   end; {of proc Initialize_Menu}
  273.  
  274.   Procedure Add_Topic(var Menu:Nest_Menu;
  275.                           Nam : MenuStr;
  276.                           Activ : boolean;
  277.                           HKey  : char;
  278.                           Code : integer;
  279.                           Sub: MenuPtr);
  280.   {Adds a new topic to the menu.}
  281.   var
  282.      TempPtr : TopicPtr;
  283.   begin
  284.       If MaxAvail < SizeOf(TempPtr^) then
  285.       begin
  286.           NestTTT_Error(1);   {not enough memory}
  287.           exit;
  288.       end
  289.       else
  290.          N_Error := 0;
  291.       If Menu.First_Topic = nil then
  292.       begin
  293.          getmem(Menu.First_Topic,SizeOf(TempPtr^));
  294.          TempPtr := Menu.First_Topic;
  295.       end
  296.       else
  297.       begin
  298.          TempPtr := Menu.First_Topic;          {start at bottom}
  299.          while TempPtr^.Next_Topic <> nil do               {loop to unallocated block}
  300.             TempPtr := TempPtr^.Next_Topic;
  301.          GetMem(TempPtr^.Next_Topic,SizeOf(TempPtr^));
  302.          TempPtr := TempPtr^.Next_Topic;
  303.       end;
  304.       with TempPtr^ do
  305.       begin
  306.           Name := Nam;
  307.           If (Name = '-') or (Name = '=') then
  308.              Active := false
  309.           else
  310.              Active := Activ;
  311.           HotKey := Hkey;
  312.           RetCode := Code;
  313.           Sub_Menu := Sub;
  314.           Next_Topic := nil;
  315.       end;
  316.       Inc(Menu.Total_Topics);
  317.   end; {of proc Add_Topic}
  318.  
  319.   Function Pointer_to_Topic(Men:Nest_Menu;TopicNo:word): TopicPtr;
  320.   {returns a pointer to the TopicNo'th entry in menu, or nil
  321.    if greater than Total_Topics}    
  322.   var
  323.      W       : word;    
  324.      TempPtr : TopicPtr;    
  325.   begin    
  326.       with Men do
  327.       begin    
  328.           If TopicNo > Total_Topics then
  329.              TempPtr := nil
  330.           else    
  331.           begin
  332.               TempPtr := First_Topic;    
  333.               For W := 2 to TopicNo do    
  334.                       TempPtr := TempPtr^.Next_Topic    
  335.           end;    
  336.       end;    
  337.       Pointer_to_Topic := TempPtr;    
  338.   end; {of func Pointer_to_Topic}
  339.  
  340.   Procedure Modify_Topic(var Menu:Nest_Menu;
  341.                              TopicNo : word;
  342.                              Nam : MenuStr;
  343.                              Activ : boolean;
  344.                              HKey  : char;
  345.                              Code : integer;
  346.                              Sub: MenuPtr);
  347.   {Changes all the settings for a topic}
  348.   var TempPtr : TopicPtr;
  349.   begin
  350.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  351.       If TempPtr = nil then 
  352.          NestTTT_Error(6);
  353.       With TempPtr^ do
  354.       begin
  355.           Name := Nam;
  356.           If (Name = '-') or (Name = '=') then
  357.              Active := false
  358.           else
  359.              Active := Activ;
  360.           HotKey := Hkey;
  361.           RetCode := Code;
  362.           Sub_Menu := Sub;
  363.       end; {with}
  364.   end; {of proc Modify_Topic}
  365.  
  366.   Procedure Modify_Topic_Name(var Menu:Nest_Menu;
  367.                                   TopicNo : word;
  368.                                   Nam : MenuStr);
  369.   {Change title or name of a topic}
  370.   var TempPtr : TopicPtr;
  371.   begin
  372.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  373.       If TempPtr = nil then 
  374.          NestTTT_Error(6);
  375.       TempPtr^.Name := Nam;
  376.       If (Nam = '-') or (Nam = '=') then
  377.              TempPtr^.Active := false;
  378.   end; {of proc Modify_Topic_Name}
  379.  
  380.   Procedure Modify_Topic_Active(var Menu:Nest_Menu;
  381.                                   TopicNo : word;
  382.                                   Activ : Boolean);
  383.   {Changes active status of a topic}
  384.   var TempPtr : TopicPtr;
  385.   begin
  386.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  387.       If TempPtr = nil then 
  388.          NestTTT_Error(6);
  389.       TempPtr^.Active := Activ;
  390.   end; {of proc Modify_Topic_Active}
  391.  
  392.   Procedure Modify_Topic_HotKey(var Menu:Nest_Menu;
  393.                                     TopicNo : word;
  394.                                     HKey : char);
  395.   {Changes Hotkey character of a topic}
  396.   var TempPtr : TopicPtr;
  397.   begin
  398.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  399.       If TempPtr = nil then
  400.          NestTTT_Error(6);
  401.       TempPtr^.HotKey := HKey;
  402.   end; {of proc Modify_Topic_HotKey}
  403.  
  404.   Procedure Modify_Topic_RetCode(var Menu:Nest_Menu;
  405.                                      TopicNo : word;
  406.                                      Code : integer);
  407.   {Changes Return code for a topic}
  408.   var TempPtr : TopicPtr;
  409.   begin
  410.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  411.       If TempPtr = nil then 
  412.          NestTTT_Error(6);
  413.       TempPtr^.Retcode := Code;
  414.   end; {of proc Modify_Topic_HotKey}
  415.  
  416.   Procedure Modify_Topic_SubMenu(var Menu:Nest_Menu;
  417.                                      TopicNo : word;
  418.                                      Sub : MenuPtr);
  419.   {Changes Return code for a topic}
  420.   var TempPtr : TopicPtr;
  421.   begin
  422.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  423.       If TempPtr = nil then
  424.          NestTTT_Error(6);
  425.       TempPtr^.Sub_Menu := Sub;
  426.   end; {of proc Modify_Topic_HotKey}
  427.  
  428.   Procedure Delete_A_Topic(var Menu:Nest_Menu;TopicNo: word);
  429.   {}
  430.   var TempPtrA,TempPtrB : TopicPtr;
  431.   begin
  432.       If TopicNo = 1 then
  433.       begin
  434.           If Menu.First_Topic = nil then
  435.              NestTTT_Error(6);
  436.           TempPtrA := Menu.First_Topic^.Next_Topic;
  437.           FreeMem(Menu.First_Topic,SizeOf(TempPtrA^));
  438.           Menu.First_Topic := TempPtrA;
  439.       end
  440.       else
  441.       begin
  442.           TempPtrA := Pointer_To_Topic(Menu,pred(TopicNo));
  443.           If TempPtrA = nil then
  444.              NestTTT_Error(6);
  445.           TempPtrB := Pointer_To_Topic(Menu,TopicNo);
  446.           If TempPtrB = nil then
  447.              NestTTT_Error(6);
  448.           TempPtrA^.Next_Topic := TempPtrB^.Next_Topic;
  449.           FreeMem(TempPtrB,SizeOf(TempPtrB^));
  450.       end;
  451.       Dec(Menu.Total_Topics);
  452.   end; {of proc Delete_A_Topic}
  453.  
  454.   Procedure Delete_All_Topics(var Menu:Nest_Menu);
  455.   {}
  456.   var TempPtrA,TempPtrB : TopicPtr;
  457.   begin
  458.       TempPtrA := Menu.First_Topic;
  459.       While (TempPtrA <> nil) do
  460.       begin
  461.           TempPtrB := TempPtrA^.Next_Topic;
  462.           If TempPtrA <> nil then
  463.           begin
  464.               FreeMem(TempPtrA,SizeOf(TempPtrA^));
  465.               TempPtrA := TempPtrB;
  466.           end;
  467.       end;
  468.       Menu.First_Topic := nil;
  469.   end; {of proc Delete_All_Topics}
  470.  
  471.   Procedure Show_Nest(var Menu:Nest_Menu);
  472.   Type
  473.      LevelInfo = record
  474.                       Pick : word;
  475.                       TheMenu : MenuPtr;     {link to menu}
  476.                       X1   : integer;           {coords of saved screens}
  477.                       Y1   : integer;
  478.                       X2   : integer;
  479.                       Y2   : integer;
  480.                       TopPick : byte;
  481.                       HiPick  : byte;
  482.                       Saved_Screen: Pointer; {location of saved screen}
  483.                  end;
  484.   Var
  485.      I : word;
  486.      TempPtr : TopicPtr;
  487.      FinCode : byte;
  488.      Nest : array[1..Max_Levels] of LevelInfo;
  489.      Current_Level : byte;
  490.      LiveMenu : Nest_menu;
  491.      ChL : char;
  492.      Found,
  493.      Finished : boolean;
  494.  
  495.       Function Topic_Pointer(TopicNo:word): TopicPtr;
  496.       begin
  497.           Topic_Pointer := Pointer_to_Topic(LiveMenu,TopicNo);
  498.       end; {of func Topic_Pointer}
  499.  
  500.  
  501.       Procedure Compute_Coords(var LiveMenu:Nest_Menu);
  502.       {determines X1,Y1,X2,Y2 for new menu}
  503.       begin
  504.           With Nest[Current_level] do
  505.           begin
  506.               If LiveMenu.Visible_Lines = 0 then
  507.                  LiveMenu.Visible_Lines := DisplayLines-2;
  508.               If LiveMenu.Total_Topics < LiveMenu.Visible_Lines then
  509.                  LiveMenu.Visible_Lines := LiveMenu.Total_Topics;
  510.               If Current_Level = 1 then
  511.               begin
  512.                   If NTTT.X = 0 then
  513.                   begin
  514.                       If NTTT.LeftSide then
  515.                       begin
  516.                           X1 := 1;
  517.                           X2 := LiveMenu.Topic_Width + 4;
  518.                       end
  519.                       else    {RightSide}
  520.                       begin
  521.                           X2 := 80;
  522.                           X1 := 80 - LiveMenu.Topic_Width - 3;
  523.                       end;
  524.                   end
  525.                   else {X not Zero}
  526.                   begin
  527.                       If NTTT.LeftSide then
  528.                       begin
  529.                           X1 := NTTT.X;
  530.                           X2 := pred(X1)+LiveMenu.Topic_Width + 4;
  531.                           If X2 > 80 then
  532.                           begin
  533.                               X2 := 80;
  534.                               X1 := X2 - 3 - LiveMenu.Topic_Width;
  535.                           end;
  536.                       end
  537.                       else    {RightSide}
  538.                       begin
  539.                           X2 := NTTT.X;
  540.                           X1 := X2 - LiveMenu.Topic_Width - 3;
  541.                           If X1 < 1 then
  542.                           begin
  543.                               X1 := 1;
  544.                               X2 := X1 +LiveMenu.Topic_Width +3;
  545.                           end;
  546.                       end;
  547.                   end;
  548.                   If NTTT.Y = 0 then
  549.                      Y1 := 1
  550.                   else
  551.                      Y1 := NTTT.Y;
  552.                   If LiveMenu.Total_Topics >= LiveMenu.Visible_Lines then
  553. {mod 5.00a}          Y2 := Y1 + succ(LiveMenu.Visible_Lines)
  554.                   else
  555.                      Y2 := Y1 + succ(LiveMenu.Total_Topics);
  556.                   If Y2 > DisplayLines then
  557.                   begin
  558.                      Y2 := DisplayLines;
  559.                      LiveMenu.Visible_Lines := Y2 - succ(Y1);
  560.                   end;
  561.               end
  562.               else   {not the first level menu}
  563.               begin
  564.                   If NTTT.LeftSide then
  565.                   begin
  566.                       X1 := pred(Nest[pred(Current_Level)].X2);
  567.                       X2 := X1 + 3 + LiveMenu.Topic_Width;
  568.                       If X2 > 80 then
  569.                       begin
  570.                           X2 := 80;
  571.                           X1 := X2 - 4 - LiveMenu.Topic_Width;
  572.                       end;
  573.                   end
  574.                   else   {rightside}
  575.                   begin
  576.                       X2 := succ(Nest[pred(Current_Level)].X1);
  577.                       X1 := X2 - LiveMenu.Topic_Width - 3;
  578.                       If X1 < 1 then
  579.                       begin
  580.                           X1 := 1;
  581.                           X2 := X1 +LiveMenu.Topic_Width +3;
  582.                       end;
  583.                   end;
  584.                   Y1 := succ(Nest[Pred(Current_Level)].Y1) +
  585.                         Nest[Pred(Current_Level)].HiPick -
  586.                         Nest[Pred(Current_Level)].TopPick;
  587.                   If LiveMenu.Total_Topics >= LiveMenu.Visible_Lines then
  588.                      Y2 := succ(Y1) + LiveMenu.Visible_Lines
  589.                   else
  590.                      Y2 := succ(Y1) + LiveMenu.Total_Topics;
  591.                   If Y2 > DisplayLines then
  592.                   begin
  593.                      Y2 := DisplayLines;
  594.                      If Y2 - succ(LiveMenu.Visible_Lines) >= 1 then
  595.                         Y1 := Y2 - succ(LiveMenu.Visible_Lines)
  596.                      else
  597.                      begin
  598.                          Y1 := 1;
  599.                          LiveMenu.Visible_Lines := DisplayLines - 2;
  600.                      end;
  601.                   end;
  602.               end;
  603.           end; {With}
  604.       end; {of proc Compute_Coords}
  605.  
  606.       Procedure Save_Screen;
  607.       {saved part of screen overlayed by menu}
  608.       begin
  609.           with Nest[Current_Level] do
  610.           begin
  611.               If MaxAvail < succ(Y2-Y1)*succ(X2-X1)*2 then
  612.                   NestTTT_Error(2)
  613.               else
  614.               begin
  615.                   GetMem(Saved_Screen,succ(Y2-Y1)*succ(X2-X1)*2);
  616.                   PartSave(X1,Y1,X2,Y2,Saved_Screen^);
  617.               end;
  618.           end;
  619.       end; {of proc Save_Screen}
  620.  
  621.       Procedure Restore_Screen;
  622.       {saved part of screen overlayed by menu}
  623.       begin
  624.           with Nest[Current_Level] do
  625.           begin
  626.               If Saved_Screen = nil then
  627.                   NestTTT_Error(4)
  628.               else
  629.               begin
  630.                   PartRestore(X1,Y1,X2,Y2,Saved_Screen^);
  631.                   FreeMem(Saved_Screen,succ(Y2-Y1)*succ(X2-X1)*2);
  632.               end;
  633.           end;
  634.       end; {of proc Restore_Screen}
  635.  
  636.       Procedure Compute_First_Active_Pick;
  637.       {}
  638.       var I : word;
  639.       begin
  640.           With Nest[Current_level] do
  641.           begin
  642.               TopPick := 1;
  643.               HiPick := 1;
  644.               While (Topic_Pointer(HiPick)^.Active = false)
  645.               and   (HiPick < LiveMenu.Total_Topics) do
  646.                     Inc(HiPick);
  647.               If (Topic_Pointer(HiPick)^.Active = false) then {no active picks in menu}
  648.               begin
  649.                   NestTTT_Error(3);
  650.                   exit;
  651.               end;
  652.               If HiPick > LiveMenu.Visible_Lines then
  653.                  TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  654.           end; {with}
  655.       end; {of proc Compute_First_Active_Pick}
  656.  
  657.       Procedure Compute_Topic_Width(var Livemenu:Nest_Menu);
  658.       {}
  659.       var
  660.         I : word;
  661.         W,Biggest : Byte;
  662.       begin
  663.           Biggest := 0;
  664.           For I := 1 To LiveMenu.Total_Topics do
  665.           begin
  666.               W := length(Topic_Pointer(I)^.Name);
  667.               If Biggest < W then
  668.                  Biggest := W;
  669.           end;
  670.           If Biggest < length(LiveMenu.Title) then
  671.              Biggest := length(LiveMenu.Title);
  672.           LiveMenu.Topic_Width := Biggest;
  673.       end; {of proc Compute_Topic_Width}
  674.  
  675.       Procedure Write_Topic(TopicNo:word;Hilight:boolean);
  676.       {}
  677.       var
  678.         A,Y : byte;
  679.         T : TopicPtr;
  680.       begin
  681.          T := Topic_Pointer(TopicNo);
  682.          If T = Nil then
  683.             exit;
  684.          If HiLight then
  685.             A := attr(NTTT.HiFCol,NTTT.HiBCol)
  686.          else
  687.          begin
  688.              If T^.Active then
  689.                 A := attr(NTTT.NorFcol,NTTT.BacCol)
  690.              else
  691.                 A := attr(NTTT.LoFcol,NTTT.BacCol);
  692.          end;
  693.          with Nest[Current_level] do
  694.          begin
  695.              Y := succ(Y1) + TopicNo - TopPick;
  696.              If HiLight then
  697.                 Fastwrite(succ(X1),Y,A,
  698.                           NTTT.LeftChar+
  699.                           PadLeft(T^.Name,LiveMenu.Topic_Width,' ')+
  700.                           NTTT.Rightchar)
  701.              else
  702.                 Case T^.Name[1] of
  703.                 '-': HorizLine(Succ(X1),Pred(X2),Y,NTTT.BoxFCol,NTTT.BacCol,1);
  704.                 '=': HorizLine(Succ(X1),Pred(X2),Y,NTTT.BoxFCol,NTTT.BacCol,1);
  705.                 else
  706.                     begin
  707.                         Fastwrite(succ(X1),Y,A,
  708.                                   ' '+
  709.                                   PadLeft(T^.Name,LiveMenu.Topic_Width,' ')+
  710.                                   ' ');
  711.                         If (T^.Active) and (First_Capital_Pos(T^.Name) > 0) then
  712.                            Fastwrite(succ(X1)+First_Capital_Pos(T^.Name),
  713.                                      Y,
  714.                                      attr(NTTT.CapFCol,NTTT.BacCol),
  715.                                      First_Capital(T^.Name));
  716.                     end;
  717.                 end; {Case}
  718.          end;
  719.       end; {of proc Write_Topic}
  720.  
  721.       Procedure Display_All_Topics;
  722.       {}
  723.       var I : Integer;
  724.       begin
  725.           with Nest[Current_Level] do
  726.           begin
  727.               For I := TopPick to TopPick+pred(LiveMenu.Visible_Lines) do
  728.                   Write_Topic(I,false);
  729.               Write_Topic(HiPick,true);
  730.           end;
  731.       end; {of proc Display_All_Topics}
  732.  
  733.       Procedure Display_LiveMenu;
  734.       {}
  735.       begin
  736.           with Nest[Current_Level] do
  737.           begin
  738.               FBox(X1,Y1,X2,Y2,NTTT.BoxFCol,NTTT.BoxBCol,NTTT.BoxType);
  739.               WriteBetween(X1,X2,Y1,NTTT.BoxFCol,NTTT.BoxBCol,Livemenu.Title);
  740.           end;
  741.           Display_All_Topics;
  742.       end; {of proc Display_LiveMenu}
  743.  
  744.       Function Next_Pick_Down(Wrap:boolean): word;
  745.       {}
  746.       var P : word;
  747.       begin
  748.           with Nest[Current_Level] do
  749.           begin
  750.               P := HiPick;
  751.               If P < LiveMenu.Total_Topics then
  752.               begin
  753.                   inc(P);
  754.                   while (P < LiveMenu.Total_Topics)
  755.                   and   (Topic_Pointer(P)^.Active = false) do
  756.                         Inc(P);
  757.                   If Topic_Pointer(P)^.Active = false then
  758.                   begin
  759.                       If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  760.                       begin
  761.                          P := TopPick;  {scroll to top}
  762.                          while (P < LiveMenu.Total_Topics)
  763.                          and   (Topic_Pointer(P)^.Active = false) do
  764.                                Inc(P);
  765.                       end
  766.                       else
  767.                          P := Hipick;
  768.                   end;
  769.               end
  770.               else     {P is at bottom of menu}
  771.               begin
  772.                   If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  773.                      P := TopPick;  {scroll to top}
  774.                   while (P < LiveMenu.Total_Topics)
  775.                   and   (Topic_Pointer(P)^.Active = false) do
  776.                         Inc(P);
  777.               end;
  778.               Next_Pick_Down := P;
  779.           end; {with}
  780.       end; {of func Next_Pick_Down}
  781.  
  782.       Function Next_Pick_Up(Wrap:boolean): word;
  783.       {}
  784.       var P : word;
  785.       begin
  786.           with Nest[Current_Level] do
  787.           begin
  788.               P := HiPick;
  789.               If P > 1 then
  790.               begin
  791.                   dec(P);
  792.                   while (P > 1)
  793.                   and   (Topic_Pointer(P)^.Active = false) do
  794.                         Dec(P);
  795.                   If Topic_Pointer(P)^.Active = false then
  796.                   begin
  797.                       If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  798.                       begin
  799.                          P := LiveMenu.Total_Topics;  {scroll to top}
  800.                          while (P > 1)
  801.                          and   (Topic_Pointer(P)^.Active = false) do
  802.                                Dec(P);
  803.                       end
  804.                       else
  805.                          P := Hipick;
  806.                   end;
  807.               end
  808.               else     {P is at top of menu}
  809.               begin
  810.                   If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  811.                   begin
  812.                      P := LiveMenu.Total_Topics;  {scroll to top}
  813.                      while (P > 1)
  814.                      and   (Topic_Pointer(P)^.Active = false) do
  815.                            Dec(P);
  816.                   end;
  817.               end;
  818.               Next_Pick_Up := P;
  819.           end; {with}
  820.       end; {of func Next_Pick_Up}
  821.  
  822.       Procedure Load_Menu(var NewMenu:Nest_Menu);
  823.       {}
  824.       begin
  825.           If Current_Level < Max_Levels then
  826.              Inc(Current_Level)
  827.           else
  828.              NestTTT_Error(5);
  829.           Nest[Current_Level].TheMenu := @NewMenu;
  830.           LiveMenu := NewMenu;
  831.           If LiveMenu.Topic_Width <= 0 then
  832.           begin
  833.              Compute_Topic_Width(LiveMenu);
  834.              NewMenu.Topic_Width := LiveMenu.Topic_Width;
  835.           end;
  836.           Compute_Coords(LiveMenu);
  837.           Compute_Coords(NewMenu);
  838.           Compute_First_Active_Pick;
  839.           Save_Screen;
  840.           Display_LiveMenu;
  841.       end; {of proc Load_Menu;}
  842.  
  843.       Procedure Execute_Command;
  844.       {}
  845.       var
  846.          TempPtr : TopicPtr;
  847.          Code : integer;
  848.       begin
  849.           TempPtr := Topic_Pointer(Nest[Current_Level].HiPick);
  850.           If TempPtr^.Sub_Menu <> nil then
  851.              Load_Menu(TempPtr^.Sub_Menu^)
  852.           else
  853.           begin
  854.               Code := TempPtr^.Retcode;
  855.               {$IFNDEF VER40}
  856.               NTTT.Despatcher(Code,Fincode);
  857.               {$ELSE}
  858.               If Nest_Despatcher <> Nil then
  859.                  CallFromNestDespatcher(Code,Fincode)
  860.               else
  861.                  Fincode := Undefined;
  862.               {$ENDIF}
  863.               Case Fincode of
  864.               Undefined    :NestTTT_Error(7);
  865.               DontClear    :;
  866.               RefreshTopic : Write_Topic(Nest[Current_Level].HiPick,True);
  867.               RefreshMenu  : Display_All_Topics;
  868.               ClearCurrent : begin
  869.                                  Restore_Screen;
  870.                                  If Current_Level > 1 then
  871.                                  begin
  872.                                     Dec(Current_Level);
  873.                                     LiveMenu := Nest[Current_Level].TheMenu^;
  874.                                  end
  875.                                  else
  876.                                     Finished := true;
  877.                              end;
  878.               ClearAll     : begin
  879.                                  While Current_Level > 0 do
  880.                                  begin
  881.                                      Restore_Screen;
  882.                                      Dec(Current_Level);
  883.                                      (*
  884.                                      LiveMenu := Nest[Current_Level].TheMenu^;
  885.                                      *)
  886.                                  end;
  887.                                  Current_Level := 1; {5.10a}
  888.                                  LiveMenu := Nest[Current_Level].TheMenu^;
  889.                                  Finished := true;
  890.                              end;
  891.               end; {Case}
  892.           end;
  893.       end; {of proc Execute_Command}
  894.  
  895.      Procedure Display_More;
  896.      {}
  897.      var A : byte;
  898.      begin
  899.          If LiveMenu.Visible_Lines < Livemenu.Total_Topics then
  900.             with  Nest[Current_Level] do
  901.             begin
  902.                 A := attr(NTTT.CapFCol,NTTT.BoxBCol);
  903.                 If TopPick > 1 then
  904.                    Fastwrite(X2,Succ(Y1),A,chr(24))
  905.                 else
  906.                    VertLine(X2,Succ(Y1),Succ(Y1),NTTT.BoxFcol,NTTT.BoxBCol,Nttt.Boxtype);
  907.                 If TopPick + Pred(LiveMenu.Visible_Lines) < LiveMenu.Total_Topics then
  908.                    Fastwrite(X2,Pred(Y2),A,chr(25))
  909.                 else
  910.                    VertLine(X2,Pred(Y2),Pred(Y2),NTTT.BoxFcol,NTTT.BoxBCol,Nttt.Boxtype);
  911.             end;
  912.      end; {of proc Display_More}
  913.  
  914.   begin
  915.       Current_level := 0;
  916.       {$IFNDEF VER40}
  917.       If not Despatcher_Assigned then
  918.          NestTTT_Error(7);
  919.       {$ELSE}
  920.       If Nest_Despatcher = nil then
  921.          NestTTT_Error(7);
  922.       {$ENDIF}
  923.       Load_Menu(Menu);
  924.       Finished := False;
  925.       Repeat
  926.            Display_More;
  927.            ChL := GetKey;
  928.            {$IFNDEF VER40}
  929.            NTTT.Hook(ChL,Topic_Pointer(Nest[Current_Level].HiPick)^.RetCode);
  930.            {$ELSE}
  931.            If Nest_UserHook <> Nil then
  932.               CallFromNestUserHook(ChL,Topic_Pointer(Nest[Current_Level].HiPick)^.RetCode);
  933.            {$ENDIF}
  934.            If ChL <> #0 then
  935.            Case upcase(ChL) of
  936.            #132,                               {right button}
  937.            #027    : If Current_Level = 1 then
  938.                      begin
  939.                          If NTTT.AllowEsc then
  940.                          begin
  941.                              Restore_Screen;
  942.                              Finished := true;
  943.                          end;
  944.                      end
  945.                      else
  946.                      begin
  947.                          Restore_Screen;
  948.                          Dec(Current_Level);
  949.                          LiveMenu := Nest[Current_Level].TheMenu^;
  950.                      end;
  951.            #133,                                       {Mouse left button}
  952.            #13     : begin                             {Enter}
  953.                          Execute_Command;
  954.                      end;
  955.            ' ',
  956.            #129,                                       {Mouse down}
  957.            #208    : with Nest[Current_Level] do       {Down arrow}
  958.                      begin
  959.                          Write_Topic(HiPick,False);
  960.                          HiPick := Next_Pick_Down(ChL = #208);
  961.                          If HiPick >= TopPick + LiveMenu.Visible_Lines then
  962.                          begin
  963.                              TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  964.                              Display_All_Topics;
  965.                          end;
  966.                          Write_Topic(HiPick,True);
  967.                      end;
  968.            #128,                                       {Mouse up}
  969.            #200    : with Nest[Current_Level] do       {Up arrow}
  970.                      begin
  971.                          Write_Topic(HiPick,False);
  972.                          HiPick := Next_Pick_Up(ChL = #200);
  973.                          If HiPick < TopPick  then
  974.                          begin
  975.                              TopPick := HiPick;
  976.                              Display_All_Topics;
  977.                          end;
  978.                          Write_Topic(HiPick,True);
  979.                      end;
  980.             #199   : If Nest[Current_Level].HiPick <> 1 then      {Home}
  981.                      begin
  982.                          Compute_First_Active_Pick;
  983.                          Display_All_Topics;
  984.                      end;
  985.             #207   : With Nest[Current_Level] do
  986.                      begin
  987.                          Write_Topic(HiPick,False);
  988.                          HiPick := LiveMenu.Total_Topics;
  989.                          While (HiPick > 0)
  990.                          and (Topic_Pointer(HiPick)^.Active =false) do
  991.                               Dec(HiPick);
  992.                          If HiPick >= TopPick + LiveMenu.Visible_Lines then
  993.                          begin
  994.                              TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  995.                              Display_All_Topics;
  996.                          end;
  997.                          Write_Topic(HiPick,True);
  998.                      end;
  999.            'A'..'Z': with Nest[Current_Level] do
  1000.                      begin
  1001.                          Found := false;
  1002.                          I := HiPick;
  1003.                          Repeat      
  1004.                               TempPtr := Topic_Pointer(I);
  1005.                               If  (First_Capital(TempPtr^.Name) = upcase(ChL))
  1006.                               and (TempPtr^.Active) then      
  1007.                               begin      
  1008.                                   Found := true;
  1009.                                   Write_Topic(HiPick,false);      
  1010.                                   HiPick := I;
  1011.                                   If HiPick >= TopPick + LiveMenu.Visible_Lines then
  1012.                                   begin
  1013.                                       TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  1014.                                       Display_All_Topics;
  1015.                                   end
  1016.                                   else
  1017.                                      If HiPick < TopPick  then
  1018.                                      begin
  1019.                                          TopPick := HiPick;
  1020.                                          Display_All_Topics;
  1021.                                      end;
  1022.                                      Write_Topic(HiPick,true);
  1023.                               end      
  1024.                               else      
  1025.                                   If I = LiveMenu.Total_Topics then
  1026.                                      I := 1
  1027.                                   else
  1028.                                      Inc(I);
  1029.                          Until Found or (I = HiPick);
  1030.                          If Found then
  1031.                             Execute_Command;
  1032.                      end;
  1033.            else   {see if the user pressed a special key}
  1034.                with Nest[Current_Level] do
  1035.                begin
  1036.                Found := false;
  1037.                I := HiPick;
  1038.                Repeat
  1039.                     TempPtr := Topic_Pointer(I);
  1040.                     If  ((TempPtr^.Hotkey) = ChL)
  1041.                     and (TempPtr^.Active) then
  1042.                     begin
  1043.                         Found := true;
  1044.                         Write_Topic(HiPick,false);
  1045.                         HiPick := I;
  1046.                         If HiPick >= TopPick + LiveMenu.Visible_Lines then
  1047.                         begin
  1048.                             TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  1049.                             Display_All_Topics;
  1050.                         end
  1051.                         else
  1052.                            If HiPick < TopPick  then
  1053.                            begin
  1054.                                TopPick := HiPick;
  1055.                                Display_All_Topics;
  1056.                            end;
  1057.                            Write_Topic(HiPick,true);
  1058.                     end
  1059.                     else
  1060.                         If I = LiveMenu.Total_Topics then
  1061.                            I := 1
  1062.                         else
  1063.                            Inc(I);
  1064.                Until Found or (I = HiPick);
  1065.                If Found then
  1066.                   Execute_Command;
  1067.                end;
  1068.       end; {case}
  1069.       Until Finished;
  1070.   end; {of proc Show_Nest}
  1071.  
  1072.  
  1073. begin
  1074.     Default_Settings;
  1075.     N_Fatal := true;
  1076. end.
  1077.  
  1078.