Ada95/samples/ncurses2-color_edit.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                       GNAT ncurses Binding Samples                       --
   4 --                                                                          --
   5 --                                 ncurses                                  --
   6 --                                                                          --
   7 --                                 B O D Y                                  --
   8 --                                                                          --
   9 ------------------------------------------------------------------------------
  10 -- Copyright (c) 2000,2004 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.4 $
  39 --  $Date: 2004/08/21 21:37:00 $
  40 --  Binding Version 01.00
  41 ------------------------------------------------------------------------------
  42 with ncurses2.util; use ncurses2.util;
  43 with ncurses2.genericPuts;
  44 with Terminal_Interface.Curses; use Terminal_Interface.Curses;
  45
  46
  47 procedure ncurses2.color_edit is
  48    use Int_IO;
  49
  50    type RGB_Enum is (Redx, Greenx, Bluex);
  51
  52    procedure change_color (current : Color_Number;
  53                            field   : RGB_Enum;
  54                            value   : RGB_Value;
  55                            usebase : Boolean);
  56
  57
  58
  59    procedure change_color (current : Color_Number;
  60                            field   : RGB_Enum;
  61                            value   : RGB_Value;
  62                            usebase : Boolean)  is
  63       red, green, blue : RGB_Value;
  64    begin
  65       if usebase then
  66          Color_Content (current, red, green, blue);
  67       else
  68          red := 0;
  69          green := 0;
  70          blue := 0;
  71       end if;
  72
  73       case field is
  74          when Redx => red :=  red + value;
  75          when Greenx => green := green + value;
  76          when Bluex => blue := blue + value;
  77       end case;
  78
  79       declare
  80       begin
  81          Init_Color (current, red, green, blue);
  82       exception
  83          when Curses_Exception => Beep;
  84       end;
  85
  86    end change_color;
  87
  88
  89    package x is new ncurses2.genericPuts (100); use x;
  90
  91    tmpb : x.BS.Bounded_String;
  92
  93    tmp4 : String (1 .. 4);
  94    tmp6 : String (1 .. 6);
  95    tmp8 : String (1 .. 8);
  96    --  This would be easier if Ada had a Bounded_String
  97    --  defined as a class instead of the inferior generic package,
  98    --  then I could define Put, Add, and Get for them. Blech.
  99    value : RGB_Value := 0;
 100    red, green, blue : RGB_Value;
 101    max_colors : constant Natural := Number_Of_Colors;
 102    current : Color_Number := 0;
 103    field : RGB_Enum := Redx;
 104    this_c : Key_Code := 0;
 105 begin
 106    Refresh;
 107
 108    for i in Color_Number'(0) .. Color_Number (Number_Of_Colors) loop
 109       Init_Pair (Color_Pair (i), White, i);
 110    end loop;
 111
 112    Move_Cursor (Line => Lines - 2, Column => 0);
 113    Add (Str => "Number: ");
 114    myPut (tmpb, Integer (value));
 115    myAdd (Str => tmpb);
 116
 117    loop
 118
 119       Switch_Character_Attribute (On => False,
 120                                   Attr => (Bold_Character => True,
 121                                            others => False));
 122       Add (Line => 0, Column => 20, Str => "Color RGB Value Editing");
 123
 124       Switch_Character_Attribute (On => False,
 125                                   Attr => (Bold_Character => True,
 126                                            others => False));
 127
 128       for i in Color_Number'(0) .. Color_Number (Number_Of_Colors) loop
 129          Move_Cursor (Line => 2 + Line_Position (i), Column => 0);
 130          if current = i then
 131             Add (Ch => '>');
 132          else
 133             Add (Ch => ' ');
 134          end if;
 135          --  TODO if i <= color_names'Max  then
 136          Put (tmp8, Integer (i));
 137          Set_Character_Attributes (Color => Color_Pair (i));
 138          Add (Str => "        ");
 139          Set_Character_Attributes;
 140
 141          Refresh;
 142
 143          Color_Content (i, red, green, blue);
 144          Add (Str => "   R = ");
 145          if current = i and field = Redx then
 146             Switch_Character_Attribute (On => True,
 147                                         Attr => (Stand_Out => True,
 148                                                  others => False));
 149          end if;
 150          Put (tmp4, Integer (red));
 151          Add (Str => tmp4);
 152          if current = i and field = Redx then
 153             Set_Character_Attributes;
 154          end if;
 155          Add (Str => "   G = ");
 156          if current = i and field =  Greenx then
 157             Switch_Character_Attribute (On => True,
 158                                         Attr => (Stand_Out => True,
 159                                                  others => False));
 160          end if;
 161          Put (tmp4, Integer (green));
 162          Add (Str => tmp4);
 163          if current = i and field = Greenx then
 164             Set_Character_Attributes;
 165          end if;
 166          Add (Str => "   B = ");
 167          if current = i and field = Bluex then
 168             Switch_Character_Attribute (On => True,
 169                                         Attr => (Stand_Out => True,
 170                                                  others => False));
 171          end if;
 172          Put (tmp4, Integer (blue));
 173          Add (Str => tmp4);
 174          if current = i and field = Bluex then
 175             Set_Character_Attributes;
 176          end if;
 177          Set_Character_Attributes;
 178          Add (ch => ')');
 179       end loop;
 180       Add (Line => Line_Position (Number_Of_Colors + 3), Column => 0,
 181            Str => "Use up/down to select a color, left/right to change " &
 182            "fields.");
 183       Add (Line => Line_Position (Number_Of_Colors + 4), Column => 0,
 184            Str => "Modify field by typing nnn=, nnn-, or nnn+.  ? for help.");
 185
 186       Move_Cursor (Line => 2 + Line_Position (current), Column => 0);
 187
 188       this_c := Getchar;
 189       if Is_Digit (this_c) then
 190          value := 0;
 191       end if;
 192
 193       case this_c is
 194          when KEY_UP =>
 195             current := (current - 1) mod Color_Number (max_colors);
 196          when KEY_DOWN =>
 197             current := (current + 1) mod Color_Number (max_colors);
 198          when KEY_RIGHT =>
 199             field := RGB_Enum'Val ((RGB_Enum'Pos (field) + 1) mod 3);
 200          when KEY_LEFT =>
 201             field := RGB_Enum'Val ((RGB_Enum'Pos (field) - 1) mod 3);
 202          when
 203            Character'Pos ('0') |
 204            Character'Pos ('1') |
 205            Character'Pos ('2') |
 206            Character'Pos ('3') |
 207            Character'Pos ('4') |
 208            Character'Pos ('5') |
 209            Character'Pos ('6') |
 210            Character'Pos ('7') |
 211            Character'Pos ('8') |
 212            Character'Pos ('9')  =>
 213             value := value * 10 + RGB_Value (ctoi (Code_To_Char (this_c)));
 214
 215          when Character'Pos ('+') =>
 216             change_color (current, field,  value, True);
 217
 218          when Character'Pos ('-') =>
 219             change_color (current, field, -value, True);
 220
 221          when Character'Pos ('=') =>
 222             change_color (current, field,  value, False);
 223
 224          when Character'Pos ('?') =>
 225             Erase;
 226             P ("                      RGB Value Editing Help");
 227             P ("");
 228             P ("You are in the RGB value editor.  Use the arrow keys to " &
 229                "select one of");
 230             P ("the fields in one of the RGB triples of the current colors;" &
 231                " the one");
 232             P ("currently selected will be reverse-video highlighted.");
 233             P ("");
 234             P ("To change a field, enter the digits of the new value; they" &
 235                " are echoed");
 236             P ("as entered.  Finish by typing `='.  The change will take" &
 237                " effect instantly.");
 238             P ("To increment or decrement a value, use the same procedure," &
 239                " but finish");
 240             P ("with a `+' or `-'.");
 241             P ("");
 242             P ("To quit, do `x' or 'q'");
 243
 244             Pause;
 245             Erase;
 246          when Character'Pos ('q') |
 247            Character'Pos ('x') =>
 248             null;
 249          when others =>
 250             Beep;
 251       end case;
 252       Move_Cursor (Line => Lines - 2, Column => 0);
 253       Put (tmp6, Integer (value));
 254       Add (Str => "Number: " & tmp6);
 255
 256       Clear_To_End_Of_Line;
 257       exit when this_c = Character'Pos ('x') or
 258         this_c = Character'Pos ('q');
 259    end loop;
 260
 261    Erase;
 262    End_Windows;
 263 end ncurses2.color_edit;