-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 2000 Free Software Foundation, Inc. --
+-- Copyright (c) 2000-2007,2008 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
--- $Revision: 1.2 $
+-- $Revision: 1.9 $
+-- $Date: 2008/07/26 18:47:26 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with ncurses2.util; use ncurses2.util;
attr : Character_Attribute_Set;
name : String;
once : Boolean) return Line_Position;
- procedure attr_getc (skip : out Integer;
+ procedure attr_getc (skip : in out Integer;
fg, bg : in out Color_Number;
result : out Boolean);
-
function subset (super, sub : Character_Attribute_Set) return Boolean is
begin
if
end if;
end subset;
-
function intersect (b, a : Character_Attribute_Set) return Boolean is
begin
if
end if;
m := rest mod 2;
rest := rest / 2;
--- if 1 = m then
--- a.Protected_Character := True;
--- end if;
+ if 1 = m then
+ a.Protected_Character := True;
+ end if;
m := rest mod 2;
rest := rest / 2;
if 1 = m then
elsif ncv > 0 and has_A_COLOR (Get_Background) then
declare
Color_Supported_Attributes :
- Character_Attribute_Set := make_record (ncv);
+ constant Character_Attribute_Set := make_record (ncv);
begin
if intersect (Color_Supported_Attributes, attr) then
Add (Str => " (NCV) ");
return row + 2;
end show_attr;
- procedure attr_getc (skip : out Integer; fg, bg : in out Color_Number;
- result : out Boolean) is
- ch : Key_Code := Getchar;
+ procedure attr_getc (skip : in out Integer;
+ fg, bg : in out Color_Number;
+ result : out Boolean) is
+ ch : constant Key_Code := Getchar;
nc : constant Color_Number := Color_Number (Number_Of_Colors);
- curscr : Window;
- pragma Import (C, curscr, "curscr");
- -- curscr is not implemented in the Ada binding
begin
result := True;
if Ada.Characters.Handling.Is_Digit (Character'Val (ch)) then
skip := ctoi (Code_To_Char (ch));
elsif ch = CTRL ('L') then
Touch;
- Touch (curscr);
+ Touch (Current_Window);
Refresh;
elsif Has_Colors then
case ch is
end if;
end attr_getc;
-
-
-- pairs could be defined as array ( Color_Number(0) .. colors - 1) of
-- array (Color_Number(0).. colors - 1) of Boolean;
pairs : array (Color_Pair'Range) of Boolean := (others => False);
begin
-- row := 2; -- weird, row is set to 0 without this.
-- TODO delete the above line, it was a gdb quirk that confused me
- if Has_Colors then declare
- pair : Color_Pair :=
+ if Has_Colors then
+ declare pair : constant Color_Pair :=
Color_Pair (fg * Color_Number (Number_Of_Colors) + bg);
- begin
- -- Go though each color pair. Assume that the number of
- -- Redefinable_Color_Pairs is 8*8 with predefined Colors 0..7
- if not pairs (pair) then
- Init_Pair (pair, fg, bg);
- pairs (pair) := True;
- end if;
- normal.Color := pair;
- end;
+ begin
+ -- Go though each color pair. Assume that the number of
+ -- Redefinable_Color_Pairs is 8*8 with predefined Colors 0..7
+ if not pairs (pair) then
+ Init_Pair (pair, fg, bg);
+ pairs (pair) := True;
+ end if;
+ normal.Color := pair;
+ end;
end if;
Set_Background (Ch => normal);
Erase;