Ada95/samples/ncurses2-color_test.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                       GNAT ncurses Binding Samples                       --
   4 --                                                                          --
   5 --                                 ncurses                                  --
   6 --                                                                          --
   7 --                                 B O D Y                                  --
   8 --                                                                          --
   9 ------------------------------------------------------------------------------
  10 -- Copyright (c) 2000 Free Software Foundation, Inc.                        --
  11 --                                                                          --
  12 -- Permission is hereby granted, free of charge, to any person obtaining a  --
  13 -- copy of this software and associated documentation files (the            --
  14 -- "Software"), to deal in the Software without restriction, including      --
  15 -- without limitation the rights to use, copy, modify, merge, publish,      --
  16 -- distribute, distribute with modifications, sublicense, and/or sell       --
  17 -- copies of the Software, and to permit persons to whom the Software is    --
  18 -- furnished to do so, subject to the following conditions:                 --
  19 --                                                                          --
  20 -- The above copyright notice and this permission notice shall be included  --
  21 -- in all copies or substantial portions of the Software.                   --
  22 --                                                                          --
  23 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
  24 -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
  25 -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
  26 -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
  27 -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
  28 -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
  29 -- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
  30 --                                                                          --
  31 -- Except as contained in this notice, the name(s) of the above copyright   --
  32 -- holders shall not be used in advertising or otherwise to promote the     --
  33 -- sale, use or other dealings in this Software without prior written       --
  34 -- authorization.                                                           --
  35 ------------------------------------------------------------------------------
  36 --  Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
  37 --  Version Control
  38 --  $Revision: 1.1 $
  39 --  Binding Version 01.00
  40 ------------------------------------------------------------------------------
  41 with ncurses2.util; use ncurses2.util;
  42
  43 with Terminal_Interface.Curses; use Terminal_Interface.Curses;
  44 with Ada.Strings.Fixed;
  45
  46 procedure ncurses2.color_test is
  47    use Int_IO;
  48
  49    procedure show_color_name (y, x : Integer; color : Integer);
  50
  51    color_names : constant array (0 .. 15) of String (1 .. 7) :=
  52      (
  53       "black",
  54       "red",
  55       "green",
  56       "yellow",
  57       "blue",
  58       "magenta",
  59       "cyan",
  60       "white",
  61       "BLACK",
  62       "RED",
  63       "GREEN",
  64       "YELLOW",
  65       "BLUE",
  66       "MAGENTA",
  67       "CYAN",
  68       "WHITE"
  69       );
  70
  71
  72    procedure show_color_name (y, x : Integer; color : Integer) is
  73       tmp5 : String (1 .. 5);
  74    begin
  75       if Number_Of_Colors > 8 then
  76
  77          Put (tmp5, color);
  78          Add (Line => Line_Position (y), Column => Column_Position (x),
  79               Str => tmp5);
  80       else
  81          Add (Line => Line_Position (y), Column => Column_Position (x),
  82               Str => color_names (color));
  83       end if;
  84    end show_color_name;
  85
  86
  87    top, width : Integer;
  88    hello : String (1 .. 5);
  89    --  tmp3 : String (1 .. 3);
  90    --  tmp2 : String (1 .. 2);
  91
  92 begin
  93    Refresh;
  94    Add (Str => "There are ");
  95    --  Put(tmp3, Number_Of_Colors*Number_Of_Colors);
  96    Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors *
  97                                                       Number_Of_Colors),
  98                                        Ada.Strings.Left));
  99    Add (Str => " color pairs");
 100    Add (Ch => newl);
 101
 102    if Number_Of_Colors > 8 then
 103       width := 4;
 104    else
 105       width := 8;
 106    end if;
 107
 108    if Number_Of_Colors > 8 then
 109       hello := "Test";
 110    else
 111       hello := "Hello";
 112    end if;
 113
 114    for Bright in Boolean loop
 115       if Number_Of_Colors > 8 then
 116          top := 0;
 117       else
 118          top := Boolean'Pos (Bright) * (Number_Of_Colors + 3);
 119       end if;
 120       Clear_To_End_Of_Screen;
 121       Move_Cursor (Line => Line_Position (top) + 1, Column => 0);
 122       --  Put(tmp2, Number_Of_Colors);
 123       Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors),
 124                                           Ada.Strings.Left));
 125       Add (Ch => 'x');
 126       Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors),
 127                                           Ada.Strings.Left));
 128       Add (Str => "  matrix of foreground/background colors, bright *");
 129       if Bright then
 130          Add (Str => "on");
 131       else
 132          Add (Str => "off");
 133       end if;
 134       Add (Ch => '*');
 135
 136       for i in 0 .. Number_Of_Colors - 1 loop
 137          show_color_name (top + 2, (i + 1) * width, i);
 138       end loop;
 139       for i in 0 .. Number_Of_Colors - 1 loop
 140          show_color_name (top + 3 + i, 0, i);
 141       end loop;
 142       for i in 1 .. Number_Of_Color_Pairs - 1 loop
 143          Init_Pair (Color_Pair (i), Color_Number (i mod Number_Of_Colors),
 144                     Color_Number (i / Number_Of_Colors));
 145          --  attron((attr_t) COLOR_PAIR(i)) -- Huh?
 146          Set_Color (Pair => Color_Pair (i));
 147          if Bright then
 148             Switch_Character_Attribute (Attr => (Bold_Character => True,
 149                                                  others => False));
 150          end if;
 151          Add (Line => Line_Position (top + 3 + (i / Number_Of_Colors)),
 152               Column => Column_Position ((i mod Number_Of_Colors + 1) *
 153                                          width),
 154               Str => hello);
 155          Set_Character_Attributes;
 156       end loop;
 157       if Number_Of_Colors > 8 or Bright then
 158          Pause;
 159       end if;
 160    end loop;
 161
 162    Erase;
 163    End_Windows;
 164 end ncurses2.color_test;