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,2006 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.2 $
  39 --  $Date: 2006/06/25 14:24:40 $
  40 --  Binding Version 01.00
  41 ------------------------------------------------------------------------------
  42 with ncurses2.util; use ncurses2.util;
  43
  44 with Terminal_Interface.Curses; use Terminal_Interface.Curses;
  45 with Ada.Strings.Fixed;
  46
  47 procedure ncurses2.color_test is
  48    use Int_IO;
  49
  50    procedure show_color_name (y, x : Integer; color : Integer);
  51
  52    color_names : constant array (0 .. 15) of String (1 .. 7) :=
  53      (
  54       "black",
  55       "red",
  56       "green",
  57       "yellow",
  58       "blue",
  59       "magenta",
  60       "cyan",
  61       "white",
  62       "BLACK",
  63       "RED",
  64       "GREEN",
  65       "YELLOW",
  66       "BLUE",
  67       "MAGENTA",
  68       "CYAN",
  69       "WHITE"
  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    top, width : Integer;
  87    hello : String (1 .. 5);
  88    --  tmp3 : String (1 .. 3);
  89    --  tmp2 : String (1 .. 2);
  90
  91 begin
  92    Refresh;
  93    Add (Str => "There are ");
  94    --  Put(tmp3, Number_Of_Colors*Number_Of_Colors);
  95    Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors *
  96                                                       Number_Of_Colors),
  97                                        Ada.Strings.Left));
  98    Add (Str => " color pairs");
  99    Add (Ch => newl);
 100
 101    if Number_Of_Colors > 8 then
 102       width := 4;
 103    else
 104       width := 8;
 105    end if;
 106
 107    if Number_Of_Colors > 8 then
 108       hello := "Test";
 109    else
 110       hello := "Hello";
 111    end if;
 112
 113    for Bright in Boolean loop
 114       if Number_Of_Colors > 8 then
 115          top := 0;
 116       else
 117          top := Boolean'Pos (Bright) * (Number_Of_Colors + 3);
 118       end if;
 119       Clear_To_End_Of_Screen;
 120       Move_Cursor (Line => Line_Position (top) + 1, Column => 0);
 121       --  Put(tmp2, Number_Of_Colors);
 122       Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors),
 123                                           Ada.Strings.Left));
 124       Add (Ch => 'x');
 125       Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors),
 126                                           Ada.Strings.Left));
 127       Add (Str => "  matrix of foreground/background colors, bright *");
 128       if Bright then
 129          Add (Str => "on");
 130       else
 131          Add (Str => "off");
 132       end if;
 133       Add (Ch => '*');
 134
 135       for i in 0 .. Number_Of_Colors - 1 loop
 136          show_color_name (top + 2, (i + 1) * width, i);
 137       end loop;
 138       for i in 0 .. Number_Of_Colors - 1 loop
 139          show_color_name (top + 3 + i, 0, i);
 140       end loop;
 141       for i in 1 .. Number_Of_Color_Pairs - 1 loop
 142          Init_Pair (Color_Pair (i), Color_Number (i mod Number_Of_Colors),
 143                     Color_Number (i / Number_Of_Colors));
 144          --  attron((attr_t) COLOR_PAIR(i)) -- Huh?
 145          Set_Color (Pair => Color_Pair (i));
 146          if Bright then
 147             Switch_Character_Attribute (Attr => (Bold_Character => True,
 148                                                  others => False));
 149          end if;
 150          Add (Line => Line_Position (top + 3 + (i / Number_Of_Colors)),
 151               Column => Column_Position ((i mod Number_Of_Colors + 1) *
 152                                          width),
 153               Str => hello);
 154          Set_Character_Attributes;
 155       end loop;
 156       if Number_Of_Colors > 8 or Bright then
 157          Pause;
 158       end if;
 159    end loop;
 160
 161    Erase;
 162    End_Windows;
 163 end ncurses2.color_test;