ncurses2-m.adb

ncurses-5.4

      Set_Raw_Mode (SwitchOn => False);
      Set_Cbreak_Mode (SwitchOn => True);
      Set_Echo_Mode (SwitchOn => False);
      Allow_Scrolling (Mode => True);
      Use_Insert_Delete_Line (Do_Idl => True);
      Set_KeyPad_Mode (SwitchOn => True);
   end Set_Terminal_Modes;


   nap_msec : Integer := 1;

   function Do_Single_Test (c : Character) return Boolean is
   begin
      case c is
         when 'a' =>
            getch_test;
         when 'b' =>
            attr_test;
         when 'c' =>
            if not Has_Colors then
               Cannot ("does not support color.");
            else
               color_test;
            end if;
         when 'd' =>
            if not Has_Colors then
               Cannot ("does not support color.");
            elsif not Can_Change_Color then
               Cannot ("has hardwired color values.");
            else
               color_edit;
            end if;
         when 'e' =>
            slk_test;
         when 'f' =>
            acs_display;
         when 'o' =>
            demo_panels (nap_msec);
         when 'g' =>
            acs_and_scroll;
         when 'i' =>
            flushinp_test (Standard_Window);
         when 'k' =>
            test_sgr_attributes;
         when 'm' =>
            menu_test;
         when 'p' =>
            demo_pad;
         when 'r' =>
            demo_forms;
         when 's' =>
            overlap_test;
         when 't' =>
            trace_set;
         when '?' =>
            null;
         when others => return False;
      end case;
      return True;
   end Do_Single_Test;


   command : Character;
   my_e_param : Soft_Label_Key_Format := Four_Four;
   assumed_colors : Boolean := False;
   default_colors : Boolean := False;
   default_fg : Color_Number := White;
   default_bg : Color_Number := Black;
   --  nap_msec was an unsigned long integer in the C version,
   --  yet napms only takes an int!

   c : Integer;
   c2 : Character;
   optind : Integer := 1; -- must be initialized to one.
   optarg : getopt.stringa;

   length : Integer;
   tmpi : Integer;

   package myio is new Ada.Text_IO.Integer_IO (Integer);
   use myio;

   save_trace : Integer := 0;
   save_trace_set : Trace_Attribute_Set;

   function main return Integer is
   begin
      loop
         Qgetopt (c, Argument_Count, Argument'Access,
                  "a:de:fhs:t:", optind, optarg);
         exit when c = -1;
         c2 := Character'Val (c);
         case c2 is
            when 'a' =>
               --  Ada doesn't have scanf, it doesn't even have a
               --  regular expression library.
               assumed_colors := True;
               myio.Get (optarg.all, Integer (default_fg), length);
               myio.Get (optarg.all (length + 2 .. optarg.all'Length),
                         Integer (default_bg), length);
            when 'd' =>
               default_colors := True;
            when 'e' =>
               myio.Get (optarg.all, tmpi, length);
               if Integer (tmpi) > 3 then
                  usage;
                  return 1;
               end if;
               my_e_param := Soft_Label_Key_Format'Val (tmpi);
            when 'f' =>
               Rip_Off_Lines (-1, rip_footer'Access);
            when 'h' =>
               Rip_Off_Lines (1, rip_header'Access);
            when 's' =>
               myio.Get (optarg.all, nap_msec, length);
            when 't' =>
               myio.Get (optarg.all, save_trace, length);
            when others =>
               usage;
               return 1;
         end case;
      end loop;

      --  the C version had a bunch of macros here.

      --   if (!isatty(fileno(stdin)))
      --   isatty is not available in the standard Ada so skip it.
      save_trace_set := To_trace (save_trace);
      Trace_On (save_trace_set);


      Init_Soft_Label_Keys (my_e_param);

      Init_Screen;
      Set_Background (Ch => (Ch    => Blank,
                             Attr  => Normal_Video,
                             Color => Color_Pair'First));

      if Has_Colors then
         Start_Color;
         if default_colors then
            Use_Default_Colors;
         elsif assumed_colors then
            Assume_Default_Colors (default_fg, default_bg);
         end if;
      end if;

      Set_Terminal_Modes;
      Save_Curses_Mode (Curses);

      End_Windows;

      --  TODO add macro #if blocks.
      Put_Line ("Welcome to " & Curses_Version & ".  Press ? for help.");

      loop
         Put_Line ("This is the ncurses main menu");
         Put_Line ("a = keyboard and mouse input test");
         Put_Line ("b = character attribute test");
         Put_Line ("c = color test pattern");
         Put_Line ("d = edit RGB color values");
         Put_Line ("e = exercise soft keys");
         Put_Line ("f = display ACS characters");
         Put_Line ("g = display windows and scrolling");
         Put_Line ("i = test of flushinp()");
         Put_Line ("k = display character attributes");
         Put_Line ("m = menu code test");
         Put_Line ("o = exercise panels library");
         Put_Line ("p = exercise pad features");
         Put_Line ("q = quit");
         Put_Line ("r = exercise forms code");
         Put_Line ("s = overlapping-refresh test");
         Put_Line ("t = set trace level");
         Put_Line ("? = repeat this command summary");

         Put ("> ");
         Flush;

         command := Ada.Characters.Latin_1.NUL;
         --              get_input:
         --              loop
         declare
            Ch : Character;
         begin
            Get (Ch);
            --  TODO if read(ch) <= 0
            --  TODO ada doesn't have an Is_Space function
            command := Ch;
            --  TODO if ch = '\n' or '\r' are these in Ada?
         end;
         --              end loop get_input;

         declare
         begin
            if Do_Single_Test (command) then
               Flush_Input;
               Set_Terminal_Modes;
               Reset_Curses_Mode (Curses);
               Clear;
               Refresh;
               End_Windows;
               if command = '?' then
                  Put_Line ("This is the ncurses capability tester.");
                  Put_Line ("You may select a test from the main menu by " &
                            "typing the");
                  Put_Line ("key letter of the choice (the letter to left " &
                            "of the =)");
                  Put_Line ("at the > prompt.  The commands `x' or `q' will " &
                            "exit.");
               end if;
               --  continue; --why continue in the C version?
            end if;
         exception
            when Curses_Exception => End_Windows;
         end;

         exit when command = 'q';
      end loop;
      return 0; -- TODO ExitProgram(EXIT_SUCCESS);
   end main;

end ncurses2.m;