{--------------------------------------------------------------------------}
{                         TechnoJock's Turbo Toolkit                       }
{                                                                          }
{                              Version   5.00                              }
{                                                                          }
{                                                                          }
{              Copyright 1986, 1989 TechnoJock Software, Inc.              }
{                           All Rights Reserved                            }
{                          Restricted by License                           }
{--------------------------------------------------------------------------}

                     {--------------------------------}                                       
                     {       Unit:  PullTTT5          }
                     {--------------------------------}


{$S-,R-,V-,D-}       

unit PullTTT5;

Interface

Uses CRT, DOS, FastTTT5, WinTTT5, KeyTTT5;

Const
    Max_Pull_Topics = 60;
    Max_Pull_Width  = 30;
type
    Pull_Array = array [1..Max_Pull_Topics] of string[Max_Pull_Width];
    {$IFDEF VER50}
     Pull_Hook = Procedure(var Ch: char; Main, Sub :byte);
    {$ENDIF}
    MenuDisplay = record
                     TopX:byte;
                     TopY:byte;
                     Style:byte;
                     FCol: byte;       {normal option foreground color}
                     BCol: byte;       {normal option background color}
                     CCol: byte;       {color of first Character}
                     MBCol: byte;      {highlight bgnd col for main pick when sub-menu displayed}
                     HFCol: byte;      {highlighted option foreground}
                     HBCol: byte;      {highlighted option background}
                     BorCol: byte;     {border foreground color}
                     Gap   : byte;     {Gap between Picks}
                     LeftChar    : char;     {left-hand topic highlight character}
                     RightChar   : char;     {right-hand topic highlight character}
                     AllowEsc    : boolean; {is Escape key operative}
                     RemoveMenu  : boolean;{clear screen on exit}
                     AlwaysDown : boolean;
                     {$IFDEF VER50}
                     Hook         : Pull_hook;
                     {$ENDIF}
                  end;
Const
    Max_MainPicks = 8;
    Max_Subpicks  = 10;
    MainInd = '\';           {symbol that indicates main menu description}

Var
  PTTT : MenuDisplay;

  {$IFNDEF VER50}
  PM_UserHook : pointer;
  {$ENDIF}

{$IFDEF VER50}
Procedure No_Hook(var Ch: char; Main, Sub :byte);
{$ENDIF}

Procedure Pull_Menu( Definition:Pull_Array; var PickM, PickS:byte);


Implementation

  {$IFDEF VER50}
  {$F+}
  Procedure No_Hook(var Ch: char; Main, Sub :byte);
  {}
  begin
  end; {of proc No_Hook}
  {$F-}
  {$ENDIF}

   {$IFNDEF VER50}
   Procedure CallFromPM(var Ch: char; Main, Sub :byte);
          Inline($FF/$1E/PM_UserHook);
   {$ENDIF}

   Procedure Default_Settings;
   begin
       {$IFNDEF VER50}
       PM_UserHook := nil;
       {$ENDIF}
       With PTTT do
       begin
           {$IFDEF VER50}
           Hook := No_Hook;
           {$ENDIF}
           TopY := 1;
           TopX := 1;
           Style := 1;
           Gap := 2;
           LeftChar := #016;
           RightChar := #017;
           AllowEsc := true;
           RemoveMenu := true;
           AlwaysDown := true;
           If BaseOfScreen = $b000 then {monochrome}
           begin
               FCol  := lightgray;
               BCol  := black;
               CCol  := white;
               MBCol  := lightgray;
               HFCol  := black;
               HBCol  := lightgray;
               BorCol := lightgray;
           end
           else                    {color}
           begin
               FCol  := yellow;
               BCol  := blue;
               CCol  := lightcyan;
               MBCol  := red;
               HFCol  := yellow;
               HBCol  := red;
               BorCol := cyan;
           end;
      end;
  end; {Proc Default_Settings}


Procedure Pull_Menu(Definition: Pull_Array; var PickM, PickS:byte);
const
    CursUp = #200  ;  CursDown = #208  ;  CursLeft = #203  ;   CursRight = #205;
    HomeKey = #199 ;  Endkey   = #207  ;  Esc      = #027  ;   Enter     = #13;
    F1      = #187 ;

type
   Sub_details = record
                    Text:  Array[0..Max_SubPicks] of string[30];
                    Total: byte;
                    Width: byte;
                    LastPick: byte;
                 end;
var
  Submenu  : array [1..Max_MainPicks] of Sub_Details;
  Tot_main : byte;              {total number of main picks}
  Main_Wid : byte;              {width of main menu box}
  Finished,                     {has user selected menu option}
  Down     : boolean;           {indicates if sub-menu displayed}
  ChM,ChT      : char;          {keypressed character}
  X1, Y1, X2, Y2 : byte;        {lower menu borders}
  Cap,Count      : byte;        {used to check if letter pressed = first char}
  Saved_Screen : Pointer;
  I                 : integer;
  TLchar,           {border submenu upper left char}
  TRchar,           {border submenu upper right char}
  BLchar,           {border submenu bottom left char}
  BRchar,           {border submenu bottom right char}
  Joinchar,         {border joining character}
  Joindownchar,     {border joining character}
  JoinleftChar,     {border joining character}
  VertChar,         {border vert character}
  Horizchar:char;   {border horiz char}


    Procedure PullError(No : byte);
    var M : string;
    begin
        Case No of
        1 : M := 'Menu definiton must start with a Main ("\") description';
        2 : M := 'Main menu definition must be at least 1 character';
        3 : M := 'Too many main menu picks.';
        4 : M := 'Too many sub-menu picks.';
        5 : M := 'No end of menu indicator found';
        6 : M := 'Must be at least two sub-menus';
        7 : M := 'Main menu will not fit in 80 characters';
        8 : M := 'No memory to save screen';
        end; {case}
        Writeln;
        Writeln(M);
        Halt;
    end; {Abort}

    Procedure Set_Style;
    {Sets variables for the box characters based on defined style}
    begin
        Case PTTT.Style of
        1  :  begin
                  TLchar := #218;
                  TRchar := #191;
                  BLchar := #192;
                  BRchar := #217;
                  Joinchar := #194;
                  Joindownchar := #193;
                  JoinleftChar := #180;
                  VertChar := #179;
                  Horizchar := #196;
              end;
        2  :  begin
                  TLchar := #201;
                  TRchar := #187;
                  BLchar := #200;
                  BRchar := #188;
                  Joinchar := #203;
                  Joindownchar := #202;
                  JoinleftChar := #185;
                  VertChar := #186;
                  Horizchar := #205;
              end;
        else
             begin
                  TLchar := ' ';
                  TRchar := ' ';
                  BLchar := ' ';
                  BRchar := ' ';
                  Joinchar := ' ';
                  Joindownchar := ' ';
                  JoinleftChar := ' ';
                  VertChar := ' ';
                  Horizchar := ' ';
              end;
        end; {Case}
    end;  {Proc Set_Style}

    Procedure Save_Screen;
    {saved part of screen overlayed by menu}
    begin
        If MaxAvail < DisplayLines*160 then
           PullError(8)
        else
        begin
            GetMem(Saved_Screen,DisplayLines*160);
            PartSave(1,1,80,DisplayLines,Saved_Screen^);
        end;
    end; {of proc Save_Screen}

    Procedure PartRestoreScreen(X1,Y1,X2,Y2:byte);
    {Move from heap to screen, part of saved screen}
    Var
       I,width     : byte;
       ScreenAdr   : integer;
    begin
        Width := succ(X2- X1);
        For I :=  Y1 to Y2 do
        begin
            ScreenAdr   := Pred(I)*160 + Pred(X1)*2;
            MoveToScreen(Mem[Seg(Saved_Screen^):ofs(Saved_Screen^)+SCreenAdr],
                         Mem[BaseOfScreen:ScreenAdr],
                         width);
        end;
    end;

      Procedure Restore_Screen;
      {saved part of screen overlayed by menu}
      begin
          PartRestore(1,1,80,DisplayLines,Saved_Screen^);
      end;

      Procedure Dispose_Screen;
      {}
      begin
          FreeMem(Saved_Screen,DisplayLines*160);
      end;

    Procedure Load_Menu_Parameters;
    { converts the MenuDesc array into the Sub_menu array, and
      determines Tot_main
    }
    var
      I, Maj, Min, Widest : integer;
      Instr : string[30];
      Finished : Boolean;
    begin
        FillChar(Submenu,sizeof(Submenu),#0);
        Tot_main := 0;
        If Definition[1][1] <> '\' then PullError(1);
        Maj := 0;
        Widest := 0;
        I := 0;
        Finished := false;
        While (I < Max_Pull_Topics) and (Finished=false) do
        begin
            Inc(I);
            If Definition[I] <> '' then
            begin
                Instr := Definition[I];
                If Instr[1] = MainInd then
                begin
                    If Maj <> 0 then           {update values for last sub menu}
                    begin
                        SubMenu[Maj].Total := Min;
                        SubMenu[Maj].Width := widest;
                    end;
                    If length(Instr) < 2 then PullError(2);
                    If Instr = Mainind + mainind then   {must have loaded all data}
                    begin                               {note number of main menu }
                        Tot_main := Maj;                   {picks and exit}
                        Finished := true;
                    end;
                    Maj := succ(Maj);
                    If Maj > Max_mainpicks then PullError(3);
                    delete(Instr,1,1);
                    SubMenu[Maj].text[0] := Instr;
                    Min := 0;                      {reset values for next sub heading}
                    Widest := 0;
                end
                else         {not a main menu heading}
                begin
                    Min := succ(Min);
                    If Min > Max_SubPicks then PullError(4);
                    SubMenu[Maj].text[Min] := Instr;
                    If length(Instr) > widest then
                       widest := length(Instr);
                end;   {if main heading}
            end;
        end; {while}
        If Tot_main = 0 then PullError(5);
        If Tot_main < 2 then PullError(6);
   end; {sub-proc Load_Menu_Parameters}

   Function First_Capital(InStr:string; Var StrPos:byte):char;
   {returns the first capital letter in a string and Character position}
   begin
       StrPos := 1;
       While (StrPos <= length(InStr))  and ((InStr[StrPos] in [#65..#90]) = false) do
              StrPos := Succ(StrPos);
       If StrPos > length(InStr) then
       begin
           StrPos := 0;
           First_Capital := ' ';
       end
       else
          First_Capital := InStr[StrPos];
   end;   {First_Capital}

   Procedure Display_Main_Picks(No : byte; Col : byte);
   { displays main heading for menu pick 'No', if Col = 1 then
     PTTT.HFCol and PTTT.MBCol cols are used without arrows, else PTTT.FCol and PTTT.BCol
     colors are used}
   var
     ChT : Char;
     X, I, B : byte;
   begin
       X := 1;
       If No = 1 then
          X := X + PTTT.TopX + PTTT.Gap
       else
       begin
           For I := 1 to No - 1 do
               X := X + length(Submenu[I].Text[0]) + PTTT.Gap;
           X := X + PTTT.TopX  + PTTT.Gap ;
       end;
       If Col > 0 then
          Fastwrite(X,PTTT.TopY+ord(PTTT.Style>0),attr(PTTT.HFCol,PTTT.MBCol),
                    Submenu[No].Text[0])
       else
       begin
           Fastwrite(X,PTTT.TopY+ord(PTTT.Style>0),attr(PTTT.FCol,PTTT.BCol),
                     +Submenu[No].Text[0]);
           ChT := First_Capital(Submenu[No].Text[0],B);
           If B <> 0 then
              FastWrite(pred(X)+B,PTTT.TopY+ord(PTTT.Style>0),
                        attr(PTTT.CCol,PTTT.BCol),ChT);
       end;
       GotoXY(X,PTTT.TopY+Ord(PTTT.Style>0));
   end; {Display Main Header}

   Procedure Display_Main_Menu;
   {draws boxes, main menu picks and draws border}
   var I : byte;
   begin
       {draw the box}
       Main_Wid := succ(PTTT.Gap) ;           {determine the width of the main menu}
       For I := 1 to Tot_Main do
           Main_Wid := Main_Wid + PTTT.Gap + length(Submenu[I].text[0]);
       If Main_Wid + PTTT.TopX - 1 > 80 then PullError(7);
       If PTTT.Style = 0 then
          ClearText(PTTT.TopX,PTTT.TopY,PTTT.TopX + Main_Wid,PTTT.TopY,PTTT.BorCol,PTTT.BCol)
       else
          Fbox(PTTT.TopX,PTTT.TopY,PTTT.TopX + Main_Wid,PTTT.TopY + 2,PTTT.BorCol,PTTT.BCol,PTTT.Style);
       For I := 1 to ToT_Main do
           Display_Main_Picks(I,0);
       Display_Main_Picks(PickM,1);
   end;  {Display_Main_Menu}

   Procedure Remove_Sub_Menu;
   var a : integer;
   begin
       Fastwrite(X1,PTTT.TopY+2,attr(PTTT.BorCol,PTTT.BCol),horizchar);
       Fastwrite(X2,PTTT.TopY+2,attr(PTTT.BorCol,PTTT.BCol),horizchar);
       PartRestoreSCreen(PTTT.TopX, succ(PTTT.TopY)+2*ord(PTTT.Style>0), 80, DisplayLines);
       If (PTTT.Style > 0 ) and (X2 >= PTTT.TopX + Main_wid) then
       begin
           A := PTTT.TopX +Main_Wid + 1;
           PartRestoreScreen(A, PTTT.TopY + 2, 80, PTTT.TopY + 2);
           Fastwrite(A - 1, PTTT.TopY+2, attr(PTTT.BorCol,PTTT.BCol),BRchar);
       end;
       SubMenu[PickM].LastPick := PickS;
   end;

   Procedure Display_Sub_Picks(No : byte; Col : byte);
   { displays sub  menu pick 'No', if Col = 1 then
     PTTT.HFCol and PTTT.HBCol cols are used and arrows, else PTTT.FCol and PTTT.BCol
     colors are used}
   var
     ChT : Char;
     B : Byte;
   begin
       If Col = 1 then
          Fastwrite(X1 + 1, succ(PTTT.TopY)+ord(PTTT.Style>0) + No ,
                    attr(PTTT.HFCol,PTTT.HBCol),
                    PTTT.LeftChar + Submenu[PickM].Text[No] + PTTT.Rightchar)
       else
       begin
          Fastwrite(X1 + 1, succ(PTTT.TopY)+Ord(PTTT.Style>0) + No ,
                    attr(PTTT.FCol,PTTT.BCol),
                    ' '+Submenu[PickM].Text[No]+' ');
          ChT := First_Capital(SubMenu[PickM].Text[No],B);
          If B <> 0 then
             FastWrite(X1+1+B,succ(PTTT.TopY)+Ord(PTTT.Style>0) + No ,
                       attr(PTTT.CCol,PTTT.BCol),ChT);
       end;
       GotoXY(X1+1,succ(PTTT.TopY)+ord(PTTT.Style>0)+ No);
   end;


   Procedure Display_Sub_Menu(No :byte);
   var
     BotLine : string;
     I : byte;
   begin
       If (Submenu[pickM].Total = 0) then
           exit
       else
           Down := true;
       X1 := pred(PTTT.TopX);                    {determine box coords of sub menu}
       If No <> 1 then
       begin
           For I := 1 to pred(No) do
               X1 := X1 + PTTT.Gap + length(Submenu[I].text[0]);
           X1 := pred(X1) + PTTT.Gap ;
       end
       else
          X1 := X1 + 2;
       X2 := X1 + Submenu[No].width + 3;
       If X2 > 80 then
       begin
           X1 := 80 - (X2 - X1) ;
           X2 := 80;
       end;
       Y1 := succ(PTTT.TopY) + ord(PTTT.Style>0);
       Y2 := Y1 + 1 + Submenu[No].total;
       Fbox(X1,Y1,X2,Y2,PTTT.BorCol,PTTT.BCol,PTTT.Style);
       Fastwrite(X1,succ(PTTT.TopY)+ord(PTTT.Style>0),attr(PTTT.BorCol,PTTT.BCol),Joinchar);
       If X2 < PTTT.TopX + Main_wid then
          Fastwrite(X2,succ(PTTT.TopY)+ord(PTTT.Style>0),attr(PTTT.BorCol,PTTT.BCol),Joinchar)
       else
       If X2 = PTTT.TopX + Main_wid then
          Fastwrite(X2,succ(PTTT.TopY)+ord(PTTT.Style>0),attr(PTTT.BorCol,PTTT.BCol),Joinleftchar)
       else
       begin
           Fastwrite(X2,PTTT.TopY+2,attr(PTTT.BorCol,PTTT.BCol),TRchar);
           Fastwrite(PTTT.TopX+Main_wid,succ(PTTT.TopY)+ord(PTTT.Style>0),attr(PTTT.BorCol,PTTT.BCol),Joindownchar);
       end;
       For I := 1 to Submenu[PickM].total do
           Display_Sub_Picks(I,2);
       PickS := SubMenu[PickM].LastPick;
       If not (PickS in [1..Submenu[PickM].Total]) then
          PickS := 1;
       Display_Sub_Picks(PickS,1);
   end;  {proc Display_Sub_Menu}

begin     {Main Procedure Display_menu}
    Set_Style;
    Load_Menu_Parameters;
    Save_Screen;
    Finished := false;
    If (PickM < 1) then
       PickM := 1;
    Display_Main_Menu;
    For I := 1 to Tot_main do
        Submenu[I].lastPick := 1;
    SubMenu[PickM].LastPick := PickS;
    If PickS <> 0 then
    begin
        Display_Sub_Menu(PickM);
        Down := true;
    end
    else
        Down := false;
    Repeat
          ChM := GetKey;
          {$IFNDEF VER50}
          If PM_UserHook <> nil then
             If Down then
                CallFromPM(ChM,PickM,PickS)
             else
                CallFromPM(ChM,PickM,0);
          {$ENDIF}
          {$IFDEF VER50}
             If Down then
                PTTT.Hook(ChM,PickM,PickS)
             else
                PTTT.Hook(ChM,PickM,0);
          {$ENDIF}
          Case upcase(ChM) of
          'A'..'Z'   : If down then    {check if letter is first letter of menu option}
                       begin
                           Count := 0;
                           Repeat
                                Count := succ(count);
                                ChT := First_Capital(Submenu[PickM].Text[count],Cap);
                                If ChT  = upcase(ChM) then
                                begin
                                    Finished := true;
                                    Display_Sub_Picks(PickS,0);
                                    PickS := Count;
                                    Display_Sub_Picks(PickS,1);
                                end;
                           Until (Finished) or (count = submenu[PickM].Total);
                       end
                       else      {down false}
                       begin
                           Count := 0;
                           Repeat
                                Count := succ(count);
                                ChT := First_Capital(Submenu[Count].Text[0],Cap);
                                If ChT = upcase(ChM) then
                                begin
                                    Display_Main_Picks(PickM,0);
                                    PickM := Count;
                                    Down := true;
                                    Display_Main_Picks(PickM,2);
                                    If not (PickS in [1..Submenu[PickM].Total]) then
                                       PickS := 1;
                                    Display_Sub_Menu(PickM);
                                end;
                           Until (Down) or (count = Tot_Main);
                       end;
          #133,          {Mouse Enter}
          Enter      : If Down or (Submenu[PickM].Total = 0) then
                       begin
                          Finished := true;
                          If Submenu[PickM].Total = 0 then PickS := 0;
                       end
                       else
                       begin
                           Down := true;
                           Display_Main_Picks(PickM,2);
                           Display_Sub_Menu(PickM);
                       end;
          #132,        {Mouse Esc}
          Esc       :  If Down then
                       begin
                           IF not PTTT.AlwaysDown then
                           begin
                               Down := false;
                               Remove_sub_menu;
                               Display_Main_menu;
                           end
                           else
                           begin
                              If PTTT.AllowEsc then
                              begin
                                  Finished := true;
                                  PickM := 0;
                              end;
                           end;
                       end
                       else
                           If PTTT.AllowEsc then
                           begin
                               Finished := true;
                               PickM := 0;
                           end;
          #0        :      begin
                           end;
          #131      :  If PickM < ToT_main then
                       begin
                           Display_main_picks(PickM,0);  {clear highlight}
                           If Down then
                              Remove_Sub_Menu;
                           PickM := succ(PickM);
                           Display_Main_Picks(PickM,1);
                           If down then
                              Display_Sub_Menu(PickM);
                       end;
          CursRight :  begin
                           Display_main_picks(PickM,0);  {clear highlight}
                           If Down then
                              Remove_Sub_Menu;
                           If PickM < ToT_main then
                              PickM := PickM + 1
                           else
                              PickM := 1;
                           Display_Main_Picks(PickM,1);
                           If down then
                               Display_Sub_Menu(PickM);
                       end;
          #130      :  If PickM > 1 then    {MouseLeft}
                       begin
                           Display_main_picks(PickM,0);  {clear highlight}
                           If Down then
                              Remove_Sub_Menu;
                           PickM := pred(PickM);
                           Display_Main_Picks(PickM,1);
                           If down then
                               Display_Sub_Menu(PickM);
                       end;

          CursLeft  :  begin
                           Display_main_picks(PickM,0);  {clear highlight}
                           If Down then
                              Remove_Sub_Menu;
                           If PickM > 1 then
                              PickM := pred(PickM)
                           else
                              PickM := Tot_Main;
                           Display_Main_Picks(PickM,1);
                           If down then
                               Display_Sub_Menu(PickM);
                       end;
          #129       : If (Submenu