1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding --
5 -- Terminal_Interface.Curses --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 1998-2004,2006 Free Software Foundation, Inc. --
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: --
20 -- The above copyright notice and this permission notice shall be included --
21 -- in all copies or substantial portions of the Software. --
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. --
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 --
35 ------------------------------------------------------------------------------
36 -- Author: Juergen Pfeifer, 1996
39 -- $Date: 2006/06/25 14:30:22 $
40 -- Binding Version 01.00
41 ------------------------------------------------------------------------------
44 with Terminal_Interface.Curses.Aux;
45 with Interfaces.C; use Interfaces.C;
46 with Interfaces.C.Strings; use Interfaces.C.Strings;
47 with Interfaces.C.Pointers;
48 with Ada.Characters.Handling; use Ada.Characters.Handling;
49 with Ada.Strings.Fixed;
50 with Ada.Unchecked_Conversion;
52 package body Terminal_Interface.Curses is
55 use type System.Bit_Order;
57 package ASF renames Ada.Strings.Fixed;
59 type chtype_array is array (size_t range <>)
60 of aliased Attributed_Character;
61 pragma Convention (C, chtype_array);
63 ------------------------------------------------------------------------------
66 function W_Get_Element (Win : in Window;
67 Offset : in Natural) return Element;
69 function W_Get_Element (Win : in Window;
70 Offset : in Natural) return Element is
71 type E_Array is array (Natural range <>) of aliased Element;
72 package C_E_Array is new
73 Interfaces.C.Pointers (Natural, Element, E_Array, Element'Val (0));
76 function To_Pointer is new
77 Ada.Unchecked_Conversion (Window, Pointer);
79 P : Pointer := To_Pointer (Win);
81 if Win = Null_Window then
82 raise Curses_Exception;
84 P := P + ptrdiff_t (Offset);
89 function W_Get_Int is new W_Get_Element (C_Int);
90 function W_Get_Short is new W_Get_Element (C_Short);
91 function W_Get_Byte is new W_Get_Element (Interfaces.C.unsigned_char);
93 function Get_Flag (Win : Window;
94 Offset : Natural) return Boolean;
96 function Get_Flag (Win : Window;
97 Offset : Natural) return Boolean
102 when 1 => Res := C_Int (W_Get_Byte (Win, Offset));
103 when 2 => Res := C_Int (W_Get_Short (Win, Offset));
104 when 4 => Res := C_Int (W_Get_Int (Win, Offset));
105 when others => raise Curses_Exception;
109 when 0 => return False;
110 when others => return True;
114 ------------------------------------------------------------------------------
115 function Key_Name (Key : in Real_Key_Code) return String
117 function Keyname (K : C_Int) return chars_ptr;
118 pragma Import (C, Keyname, "keyname");
122 if Key <= Character'Pos (Character'Last) then
123 Ch := Character'Val (Key);
124 if Is_Control (Ch) then
125 return Un_Control (Attributed_Character'(Ch => Ch,
126 Color => Color_Pair'First,
127 Attr => Normal_Video));
128 elsif Is_Graphic (Ch) then
139 return Fill_String (Keyname (C_Int (Key)));
143 procedure Key_Name (Key : in Real_Key_Code;
147 ASF.Move (Key_Name (Key), Name);
150 ------------------------------------------------------------------------------
151 procedure Init_Screen
153 function Initscr return Window;
154 pragma Import (C, Initscr, "initscr");
159 if W = Null_Window then
160 raise Curses_Exception;
164 procedure End_Windows
166 function Endwin return C_Int;
167 pragma Import (C, Endwin, "endwin");
169 if Endwin = Curses_Err then
170 raise Curses_Exception;
174 function Is_End_Window return Boolean
176 function Isendwin return Curses_Bool;
177 pragma Import (C, Isendwin, "isendwin");
179 if Isendwin = Curses_Bool_False then
185 ------------------------------------------------------------------------------
186 procedure Move_Cursor (Win : in Window := Standard_Window;
187 Line : in Line_Position;
188 Column : in Column_Position)
190 function Wmove (Win : Window;
194 pragma Import (C, Wmove, "wmove");
196 if Wmove (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
197 raise Curses_Exception;
200 ------------------------------------------------------------------------------
201 procedure Add (Win : in Window := Standard_Window;
202 Ch : in Attributed_Character)
204 function Waddch (W : Window;
205 Ch : C_Chtype) return C_Int;
206 pragma Import (C, Waddch, "waddch");
208 if Waddch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
209 raise Curses_Exception;
213 procedure Add (Win : in Window := Standard_Window;
218 Attributed_Character'(Ch => Ch,
219 Color => Color_Pair'First,
220 Attr => Normal_Video));
224 (Win : in Window := Standard_Window;
225 Line : in Line_Position;
226 Column : in Column_Position;
227 Ch : in Attributed_Character)
229 function mvwaddch (W : Window;
232 Ch : C_Chtype) return C_Int;
233 pragma Import (C, mvwaddch, "mvwaddch");
235 if mvwaddch (Win, C_Int (Line),
237 AttrChar_To_Chtype (Ch)) = Curses_Err then
238 raise Curses_Exception;
243 (Win : in Window := Standard_Window;
244 Line : in Line_Position;
245 Column : in Column_Position;
252 Attributed_Character'(Ch => Ch,
253 Color => Color_Pair'First,
254 Attr => Normal_Video));
257 procedure Add_With_Immediate_Echo
258 (Win : in Window := Standard_Window;
259 Ch : in Attributed_Character)
261 function Wechochar (W : Window;
262 Ch : C_Chtype) return C_Int;
263 pragma Import (C, Wechochar, "wechochar");
265 if Wechochar (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
266 raise Curses_Exception;
268 end Add_With_Immediate_Echo;
270 procedure Add_With_Immediate_Echo
271 (Win : in Window := Standard_Window;
275 Add_With_Immediate_Echo
277 Attributed_Character'(Ch => Ch,
278 Color => Color_Pair'First,
279 Attr => Normal_Video));
280 end Add_With_Immediate_Echo;
281 ------------------------------------------------------------------------------
282 function Create (Number_Of_Lines : Line_Count;
283 Number_Of_Columns : Column_Count;
284 First_Line_Position : Line_Position;
285 First_Column_Position : Column_Position) return Window
287 function Newwin (Number_Of_Lines : C_Int;
288 Number_Of_Columns : C_Int;
289 First_Line_Position : C_Int;
290 First_Column_Position : C_Int) return Window;
291 pragma Import (C, Newwin, "newwin");
295 W := Newwin (C_Int (Number_Of_Lines),
296 C_Int (Number_Of_Columns),
297 C_Int (First_Line_Position),
298 C_Int (First_Column_Position));
299 if W = Null_Window then
300 raise Curses_Exception;
305 procedure Delete (Win : in out Window)
307 function Wdelwin (W : Window) return C_Int;
308 pragma Import (C, Wdelwin, "delwin");
310 if Wdelwin (Win) = Curses_Err then
311 raise Curses_Exception;
317 (Win : Window := Standard_Window;
318 Number_Of_Lines : Line_Count;
319 Number_Of_Columns : Column_Count;
320 First_Line_Position : Line_Position;
321 First_Column_Position : Column_Position) return Window
325 Number_Of_Lines : C_Int;
326 Number_Of_Columns : C_Int;
327 First_Line_Position : C_Int;
328 First_Column_Position : C_Int) return Window;
329 pragma Import (C, Subwin, "subwin");
334 C_Int (Number_Of_Lines),
335 C_Int (Number_Of_Columns),
336 C_Int (First_Line_Position),
337 C_Int (First_Column_Position));
338 if W = Null_Window then
339 raise Curses_Exception;
344 function Derived_Window
345 (Win : Window := Standard_Window;
346 Number_Of_Lines : Line_Count;
347 Number_Of_Columns : Column_Count;
348 First_Line_Position : Line_Position;
349 First_Column_Position : Column_Position) return Window
353 Number_Of_Lines : C_Int;
354 Number_Of_Columns : C_Int;
355 First_Line_Position : C_Int;
356 First_Column_Position : C_Int) return Window;
357 pragma Import (C, Derwin, "derwin");
362 C_Int (Number_Of_Lines),
363 C_Int (Number_Of_Columns),
364 C_Int (First_Line_Position),
365 C_Int (First_Column_Position));
366 if W = Null_Window then
367 raise Curses_Exception;
372 function Duplicate (Win : Window) return Window
374 function Dupwin (Win : Window) return Window;
375 pragma Import (C, Dupwin, "dupwin");
377 W : constant Window := Dupwin (Win);
379 if W = Null_Window then
380 raise Curses_Exception;
385 procedure Move_Window (Win : in Window;
386 Line : in Line_Position;
387 Column : in Column_Position)
389 function Mvwin (Win : Window;
391 Column : C_Int) return C_Int;
392 pragma Import (C, Mvwin, "mvwin");
394 if Mvwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
395 raise Curses_Exception;
399 procedure Move_Derived_Window (Win : in Window;
400 Line : in Line_Position;
401 Column : in Column_Position)
403 function Mvderwin (Win : Window;
405 Column : C_Int) return C_Int;
406 pragma Import (C, Mvderwin, "mvderwin");
408 if Mvderwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
409 raise Curses_Exception;
411 end Move_Derived_Window;
413 procedure Set_Synch_Mode (Win : in Window := Standard_Window;
414 Mode : in Boolean := False)
416 function Syncok (Win : Window;
417 Mode : Curses_Bool) return C_Int;
418 pragma Import (C, Syncok, "syncok");
420 if Syncok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
421 raise Curses_Exception;
424 ------------------------------------------------------------------------------
425 procedure Add (Win : in Window := Standard_Window;
427 Len : in Integer := -1)
429 function Waddnstr (Win : Window;
431 Len : C_Int := -1) return C_Int;
432 pragma Import (C, Waddnstr, "waddnstr");
434 Txt : char_array (0 .. Str'Length);
437 To_C (Str, Txt, Length);
438 if Waddnstr (Win, Txt, C_Int (Len)) = Curses_Err then
439 raise Curses_Exception;
444 (Win : in Window := Standard_Window;
445 Line : in Line_Position;
446 Column : in Column_Position;
448 Len : in Integer := -1)
451 Move_Cursor (Win, Line, Column);
454 ------------------------------------------------------------------------------
456 (Win : in Window := Standard_Window;
457 Str : in Attributed_String;
458 Len : in Integer := -1)
460 function Waddchnstr (Win : Window;
462 Len : C_Int := -1) return C_Int;
463 pragma Import (C, Waddchnstr, "waddchnstr");
465 Txt : chtype_array (0 .. Str'Length);
467 for Length in 1 .. size_t (Str'Length) loop
468 Txt (Length - 1) := Str (Natural (Length));
470 Txt (Str'Length) := Default_Character;
473 C_Int (Len)) = Curses_Err then
474 raise Curses_Exception;
479 (Win : in Window := Standard_Window;
480 Line : in Line_Position;
481 Column : in Column_Position;
482 Str : in Attributed_String;
483 Len : in Integer := -1)
486 Move_Cursor (Win, Line, Column);
489 ------------------------------------------------------------------------------
491 (Win : in Window := Standard_Window;
492 Left_Side_Symbol : in Attributed_Character := Default_Character;
493 Right_Side_Symbol : in Attributed_Character := Default_Character;
494 Top_Side_Symbol : in Attributed_Character := Default_Character;
495 Bottom_Side_Symbol : in Attributed_Character := Default_Character;
496 Upper_Left_Corner_Symbol : in Attributed_Character := Default_Character;
497 Upper_Right_Corner_Symbol : in Attributed_Character := Default_Character;
498 Lower_Left_Corner_Symbol : in Attributed_Character := Default_Character;
499 Lower_Right_Corner_Symbol : in Attributed_Character := Default_Character)
501 function Wborder (W : Window;
509 LRC : C_Chtype) return C_Int;
510 pragma Import (C, Wborder, "wborder");
513 AttrChar_To_Chtype (Left_Side_Symbol),
514 AttrChar_To_Chtype (Right_Side_Symbol),
515 AttrChar_To_Chtype (Top_Side_Symbol),
516 AttrChar_To_Chtype (Bottom_Side_Symbol),
517 AttrChar_To_Chtype (Upper_Left_Corner_Symbol),
518 AttrChar_To_Chtype (Upper_Right_Corner_Symbol),
519 AttrChar_To_Chtype (Lower_Left_Corner_Symbol),
520 AttrChar_To_Chtype (Lower_Right_Corner_Symbol)
523 raise Curses_Exception;
528 (Win : in Window := Standard_Window;
529 Vertical_Symbol : in Attributed_Character := Default_Character;
530 Horizontal_Symbol : in Attributed_Character := Default_Character)
534 Vertical_Symbol, Vertical_Symbol,
535 Horizontal_Symbol, Horizontal_Symbol);
538 procedure Horizontal_Line
539 (Win : in Window := Standard_Window;
540 Line_Size : in Natural;
541 Line_Symbol : in Attributed_Character := Default_Character)
543 function Whline (W : Window;
545 Len : C_Int) return C_Int;
546 pragma Import (C, Whline, "whline");
549 AttrChar_To_Chtype (Line_Symbol),
550 C_Int (Line_Size)) = Curses_Err then
551 raise Curses_Exception;
555 procedure Vertical_Line
556 (Win : in Window := Standard_Window;
557 Line_Size : in Natural;
558 Line_Symbol : in Attributed_Character := Default_Character)
560 function Wvline (W : Window;
562 Len : C_Int) return C_Int;
563 pragma Import (C, Wvline, "wvline");
566 AttrChar_To_Chtype (Line_Symbol),
567 C_Int (Line_Size)) = Curses_Err then
568 raise Curses_Exception;
572 ------------------------------------------------------------------------------
573 function Get_Keystroke (Win : Window := Standard_Window)
576 function Wgetch (W : Window) return C_Int;
577 pragma Import (C, Wgetch, "wgetch");
579 C : constant C_Int := Wgetch (Win);
581 if C = Curses_Err then
584 return Real_Key_Code (C);
588 procedure Undo_Keystroke (Key : in Real_Key_Code)
590 function Ungetch (Ch : C_Int) return C_Int;
591 pragma Import (C, Ungetch, "ungetch");
593 if Ungetch (C_Int (Key)) = Curses_Err then
594 raise Curses_Exception;
598 function Has_Key (Key : Special_Key_Code) return Boolean
600 function Haskey (Key : C_Int) return C_Int;
601 pragma Import (C, Haskey, "has_key");
603 if Haskey (C_Int (Key)) = Curses_False then
610 function Is_Function_Key (Key : Special_Key_Code) return Boolean
612 L : constant Special_Key_Code := Special_Key_Code (Natural (Key_F0) +
613 Natural (Function_Key_Number'Last));
615 if (Key >= Key_F0) and then (Key <= L) then
622 function Function_Key (Key : Real_Key_Code)
623 return Function_Key_Number
626 if Is_Function_Key (Key) then
627 return Function_Key_Number (Key - Key_F0);
629 raise Constraint_Error;
633 function Function_Key_Code (Key : Function_Key_Number) return Real_Key_Code
636 return Real_Key_Code (Natural (Key_F0) + Natural (Key));
637 end Function_Key_Code;
638 ------------------------------------------------------------------------------
639 procedure Standout (Win : Window := Standard_Window;
640 On : Boolean := True)
642 function wstandout (Win : Window) return C_Int;
643 pragma Import (C, wstandout, "wstandout");
644 function wstandend (Win : Window) return C_Int;
645 pragma Import (C, wstandend, "wstandend");
650 Err := wstandout (Win);
652 Err := wstandend (Win);
654 if Err = Curses_Err then
655 raise Curses_Exception;
659 procedure Switch_Character_Attribute
660 (Win : in Window := Standard_Window;
661 Attr : in Character_Attribute_Set := Normal_Video;
662 On : in Boolean := True)
664 function Wattron (Win : Window;
665 C_Attr : C_AttrType) return C_Int;
666 pragma Import (C, Wattron, "wattr_on");
667 function Wattroff (Win : Window;
668 C_Attr : C_AttrType) return C_Int;
669 pragma Import (C, Wattroff, "wattr_off");
670 -- In Ada we use the On Boolean to control whether or not we want to
671 -- switch on or off the attributes in the set.
673 AC : constant Attributed_Character := (Ch => Character'First,
674 Color => Color_Pair'First,
678 Err := Wattron (Win, AttrChar_To_AttrType (AC));
680 Err := Wattroff (Win, AttrChar_To_AttrType (AC));
682 if Err = Curses_Err then
683 raise Curses_Exception;
685 end Switch_Character_Attribute;
687 procedure Set_Character_Attributes
688 (Win : in Window := Standard_Window;
689 Attr : in Character_Attribute_Set := Normal_Video;
690 Color : in Color_Pair := Color_Pair'First)
692 function Wattrset (Win : Window;
693 C_Attr : C_AttrType) return C_Int;
694 pragma Import (C, Wattrset, "wattrset"); -- ??? wattr_set
697 AttrChar_To_AttrType (Attributed_Character'
698 (Ch => Character'First,
700 Attr => Attr))) = Curses_Err then
701 raise Curses_Exception;
703 end Set_Character_Attributes;
705 function Get_Character_Attribute (Win : Window := Standard_Window)
706 return Character_Attribute_Set
708 function Wattrget (Win : Window;
709 Atr : access C_AttrType;
710 Col : access C_Short;
711 Opt : System.Address) return C_Int;
712 pragma Import (C, Wattrget, "wattr_get");
714 Attr : aliased C_AttrType;
715 Col : aliased C_Short;
716 Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
717 System.Null_Address);
718 Ch : Attributed_Character;
720 if Res = Curses_Ok then
721 Ch := AttrType_To_AttrChar (Attr);
724 raise Curses_Exception;
726 end Get_Character_Attribute;
728 function Get_Character_Attribute (Win : Window := Standard_Window)
731 function Wattrget (Win : Window;
732 Atr : access C_AttrType;
733 Col : access C_Short;
734 Opt : System.Address) return C_Int;
735 pragma Import (C, Wattrget, "wattr_get");
737 Attr : aliased C_AttrType;
738 Col : aliased C_Short;
739 Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
740 System.Null_Address);
741 Ch : Attributed_Character;
743 if Res = Curses_Ok then
744 Ch := AttrType_To_AttrChar (Attr);
747 raise Curses_Exception;
749 end Get_Character_Attribute;
751 procedure Set_Color (Win : in Window := Standard_Window;
752 Pair : in Color_Pair)
754 function Wset_Color (Win : Window;
756 Opts : C_Void_Ptr) return C_Int;
757 pragma Import (C, Wset_Color, "wcolor_set");
761 C_Void_Ptr (System.Null_Address)) = Curses_Err then
762 raise Curses_Exception;
766 procedure Change_Attributes
767 (Win : in Window := Standard_Window;
768 Count : in Integer := -1;
769 Attr : in Character_Attribute_Set := Normal_Video;
770 Color : in Color_Pair := Color_Pair'First)
772 function Wchgat (Win : Window;
776 Opts : System.Address := System.Null_Address)
778 pragma Import (C, Wchgat, "wchgat");
780 Ch : constant Attributed_Character :=
781 (Ch => Character'First, Color => Color_Pair'First, Attr => Attr);
783 if Wchgat (Win, C_Int (Count), AttrChar_To_AttrType (Ch),
784 C_Short (Color)) = Curses_Err then
785 raise Curses_Exception;
787 end Change_Attributes;
789 procedure Change_Attributes
790 (Win : in Window := Standard_Window;
791 Line : in Line_Position := Line_Position'First;
792 Column : in Column_Position := Column_Position'First;
793 Count : in Integer := -1;
794 Attr : in Character_Attribute_Set := Normal_Video;
795 Color : in Color_Pair := Color_Pair'First)
798 Move_Cursor (Win, Line, Column);
799 Change_Attributes (Win, Count, Attr, Color);
800 end Change_Attributes;
801 ------------------------------------------------------------------------------
804 function Beeper return C_Int;
805 pragma Import (C, Beeper, "beep");
807 if Beeper = Curses_Err then
808 raise Curses_Exception;
812 procedure Flash_Screen
814 function Flash return C_Int;
815 pragma Import (C, Flash, "flash");
817 if Flash = Curses_Err then
818 raise Curses_Exception;
821 ------------------------------------------------------------------------------
822 procedure Set_Cbreak_Mode (SwitchOn : in Boolean := True)
824 function Cbreak return C_Int;
825 pragma Import (C, Cbreak, "cbreak");
826 function NoCbreak return C_Int;
827 pragma Import (C, NoCbreak, "nocbreak");
836 if Err = Curses_Err then
837 raise Curses_Exception;
841 procedure Set_Raw_Mode (SwitchOn : in Boolean := True)
843 function Raw return C_Int;
844 pragma Import (C, Raw, "raw");
845 function NoRaw return C_Int;
846 pragma Import (C, NoRaw, "noraw");
855 if Err = Curses_Err then
856 raise Curses_Exception;
860 procedure Set_Echo_Mode (SwitchOn : in Boolean := True)
862 function Echo return C_Int;
863 pragma Import (C, Echo, "echo");
864 function NoEcho return C_Int;
865 pragma Import (C, NoEcho, "noecho");
874 if Err = Curses_Err then
875 raise Curses_Exception;
879 procedure Set_Meta_Mode (Win : in Window := Standard_Window;
880 SwitchOn : in Boolean := True)
882 function Meta (W : Window; Mode : Curses_Bool) return C_Int;
883 pragma Import (C, Meta, "meta");
885 if Meta (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then
886 raise Curses_Exception;
890 procedure Set_KeyPad_Mode (Win : in Window := Standard_Window;
891 SwitchOn : in Boolean := True)
893 function Keypad (W : Window; Mode : Curses_Bool) return C_Int;
894 pragma Import (C, Keypad, "keypad");
896 if Keypad (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then
897 raise Curses_Exception;
901 function Get_KeyPad_Mode (Win : in Window := Standard_Window)
905 return Get_Flag (Win, Offset_use_keypad);
908 procedure Half_Delay (Amount : in Half_Delay_Amount)
910 function Halfdelay (Amount : C_Int) return C_Int;
911 pragma Import (C, Halfdelay, "halfdelay");
913 if Halfdelay (C_Int (Amount)) = Curses_Err then
914 raise Curses_Exception;
918 procedure Set_Flush_On_Interrupt_Mode
919 (Win : in Window := Standard_Window;
920 Mode : in Boolean := True)
922 function Intrflush (Win : Window; Mode : Curses_Bool) return C_Int;
923 pragma Import (C, Intrflush, "intrflush");
925 if Intrflush (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
926 raise Curses_Exception;
928 end Set_Flush_On_Interrupt_Mode;
930 procedure Set_Queue_Interrupt_Mode
931 (Win : in Window := Standard_Window;
932 Flush : in Boolean := True)
935 pragma Import (C, Qiflush, "qiflush");
936 procedure No_Qiflush;
937 pragma Import (C, No_Qiflush, "noqiflush");
939 if Win = Null_Window then
940 raise Curses_Exception;
947 end Set_Queue_Interrupt_Mode;
949 procedure Set_NoDelay_Mode
950 (Win : in Window := Standard_Window;
951 Mode : in Boolean := False)
953 function Nodelay (Win : Window; Mode : Curses_Bool) return C_Int;
954 pragma Import (C, Nodelay, "nodelay");
956 if Nodelay (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
957 raise Curses_Exception;
959 end Set_NoDelay_Mode;
961 procedure Set_Timeout_Mode (Win : in Window := Standard_Window;
962 Mode : in Timeout_Mode;
965 function Wtimeout (Win : Window; Amount : C_Int) return C_Int;
966 pragma Import (C, Wtimeout, "wtimeout");
971 when Blocking => Time := -1;
972 when Non_Blocking => Time := 0;
975 raise Constraint_Error;
977 Time := C_Int (Amount);
979 if Wtimeout (Win, Time) = Curses_Err then
980 raise Curses_Exception;
982 end Set_Timeout_Mode;
984 procedure Set_Escape_Timer_Mode
985 (Win : in Window := Standard_Window;
986 Timer_Off : in Boolean := False)
988 function Notimeout (Win : Window; Mode : Curses_Bool) return C_Int;
989 pragma Import (C, Notimeout, "notimeout");
991 if Notimeout (Win, Curses_Bool (Boolean'Pos (Timer_Off)))
993 raise Curses_Exception;
995 end Set_Escape_Timer_Mode;
997 ------------------------------------------------------------------------------
998 procedure Set_NL_Mode (SwitchOn : in Boolean := True)
1000 function NL return C_Int;
1001 pragma Import (C, NL, "nl");
1002 function NoNL return C_Int;
1003 pragma Import (C, NoNL, "nonl");
1012 if Err = Curses_Err then
1013 raise Curses_Exception;
1017 procedure Clear_On_Next_Update
1018 (Win : in Window := Standard_Window;
1019 Do_Clear : in Boolean := True)
1021 function Clear_Ok (W : Window; Flag : Curses_Bool) return C_Int;
1022 pragma Import (C, Clear_Ok, "clearok");
1024 if Clear_Ok (Win, Curses_Bool (Boolean'Pos (Do_Clear))) = Curses_Err then
1025 raise Curses_Exception;
1027 end Clear_On_Next_Update;
1029 procedure Use_Insert_Delete_Line
1030 (Win : in Window := Standard_Window;
1031 Do_Idl : in Boolean := True)
1033 function IDL_Ok (W : Window; Flag : Curses_Bool) return C_Int;
1034 pragma Import (C, IDL_Ok, "idlok");
1036 if IDL_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idl))) = Curses_Err then
1037 raise Curses_Exception;
1039 end Use_Insert_Delete_Line;
1041 procedure Use_Insert_Delete_Character
1042 (Win : in Window := Standard_Window;
1043 Do_Idc : in Boolean := True)
1045 function IDC_Ok (W : Window; Flag : Curses_Bool) return C_Int;
1046 pragma Import (C, IDC_Ok, "idcok");
1048 if IDC_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idc))) = Curses_Err then
1049 raise Curses_Exception;
1051 end Use_Insert_Delete_Character;
1053 procedure Leave_Cursor_After_Update
1054 (Win : in Window := Standard_Window;
1055 Do_Leave : in Boolean := True)
1057 function Leave_Ok (W : Window; Flag : Curses_Bool) return C_Int;
1058 pragma Import (C, Leave_Ok, "leaveok");
1060 if Leave_Ok (Win, Curses_Bool (Boolean'Pos (Do_Leave))) = Curses_Err then
1061 raise Curses_Exception;
1063 end Leave_Cursor_After_Update;
1065 procedure Immediate_Update_Mode
1066 (Win : in Window := Standard_Window;
1067 Mode : in Boolean := False)
1069 function Immedok (Win : Window; Mode : Curses_Bool) return C_Int;
1070 pragma Import (C, Immedok, "immedok");
1072 if Immedok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
1073 raise Curses_Exception;
1075 end Immediate_Update_Mode;
1077 procedure Allow_Scrolling
1078 (Win : in Window := Standard_Window;
1079 Mode : in Boolean := False)
1081 function Scrollok (Win : Window; Mode : Curses_Bool) return C_Int;
1082 pragma Import (C, Scrollok, "scrollok");
1084 if Scrollok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
1085 raise Curses_Exception;
1087 end Allow_Scrolling;
1089 function Scrolling_Allowed (Win : Window := Standard_Window)
1093 return Get_Flag (Win, Offset_scroll);
1094 end Scrolling_Allowed;
1096 procedure Set_Scroll_Region
1097 (Win : in Window := Standard_Window;
1098 Top_Line : in Line_Position;
1099 Bottom_Line : in Line_Position)
1101 function Wsetscrreg (Win : Window;
1103 Col : C_Int) return C_Int;
1104 pragma Import (C, Wsetscrreg, "wsetscrreg");
1106 if Wsetscrreg (Win, C_Int (Top_Line), C_Int (Bottom_Line))
1108 raise Curses_Exception;
1110 end Set_Scroll_Region;
1111 ------------------------------------------------------------------------------
1112 procedure Update_Screen
1114 function Do_Update return C_Int;
1115 pragma Import (C, Do_Update, "doupdate");
1117 if Do_Update = Curses_Err then
1118 raise Curses_Exception;
1122 procedure Refresh (Win : in Window := Standard_Window)
1124 function Wrefresh (W : Window) return C_Int;
1125 pragma Import (C, Wrefresh, "wrefresh");
1127 if Wrefresh (Win) = Curses_Err then
1128 raise Curses_Exception;
1132 procedure Refresh_Without_Update
1133 (Win : in Window := Standard_Window)
1135 function Wnoutrefresh (W : Window) return C_Int;
1136 pragma Import (C, Wnoutrefresh, "wnoutrefresh");
1138 if Wnoutrefresh (Win) = Curses_Err then
1139 raise Curses_Exception;
1141 end Refresh_Without_Update;
1143 procedure Redraw (Win : in Window := Standard_Window)
1145 function Redrawwin (Win : Window) return C_Int;
1146 pragma Import (C, Redrawwin, "redrawwin");
1148 if Redrawwin (Win) = Curses_Err then
1149 raise Curses_Exception;
1154 (Win : in Window := Standard_Window;
1155 Begin_Line : in Line_Position;
1156 Line_Count : in Positive)
1158 function Wredrawln (Win : Window; First : C_Int; Cnt : C_Int)
1160 pragma Import (C, Wredrawln, "wredrawln");
1164 C_Int (Line_Count)) = Curses_Err then
1165 raise Curses_Exception;
1169 ------------------------------------------------------------------------------
1170 procedure Erase (Win : in Window := Standard_Window)
1172 function Werase (W : Window) return C_Int;
1173 pragma Import (C, Werase, "werase");
1175 if Werase (Win) = Curses_Err then
1176 raise Curses_Exception;
1180 procedure Clear (Win : in Window := Standard_Window)
1182 function Wclear (W : Window) return C_Int;
1183 pragma Import (C, Wclear, "wclear");
1185 if Wclear (Win) = Curses_Err then
1186 raise Curses_Exception;
1190 procedure Clear_To_End_Of_Screen (Win : in Window := Standard_Window)
1192 function Wclearbot (W : Window) return C_Int;
1193 pragma Import (C, Wclearbot, "wclrtobot");
1195 if Wclearbot (Win) = Curses_Err then
1196 raise Curses_Exception;
1198 end Clear_To_End_Of_Screen;
1200 procedure Clear_To_End_Of_Line (Win : in Window := Standard_Window)
1202 function Wcleareol (W : Window) return C_Int;
1203 pragma Import (C, Wcleareol, "wclrtoeol");
1205 if Wcleareol (Win) = Curses_Err then
1206 raise Curses_Exception;
1208 end Clear_To_End_Of_Line;
1209 ------------------------------------------------------------------------------
1210 procedure Set_Background
1211 (Win : in Window := Standard_Window;
1212 Ch : in Attributed_Character)
1214 procedure WBackground (W : in Window; Ch : in C_Chtype);
1215 pragma Import (C, WBackground, "wbkgdset");
1217 WBackground (Win, AttrChar_To_Chtype (Ch));
1220 procedure Change_Background
1221 (Win : in Window := Standard_Window;
1222 Ch : in Attributed_Character)
1224 function WChangeBkgd (W : Window; Ch : C_Chtype) return C_Int;
1225 pragma Import (C, WChangeBkgd, "wbkgd");
1227 if WChangeBkgd (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
1228 raise Curses_Exception;
1230 end Change_Background;
1232 function Get_Background (Win : Window := Standard_Window)
1233 return Attributed_Character
1235 function Wgetbkgd (Win : Window) return C_Chtype;
1236 pragma Import (C, Wgetbkgd, "getbkgd");
1238 return Chtype_To_AttrChar (Wgetbkgd (Win));
1240 ------------------------------------------------------------------------------
1241 procedure Change_Lines_Status (Win : in Window := Standard_Window;
1242 Start : in Line_Position;
1243 Count : in Positive;
1246 function Wtouchln (Win : Window;
1249 Chg : C_Int) return C_Int;
1250 pragma Import (C, Wtouchln, "wtouchln");
1252 if Wtouchln (Win, C_Int (Start), C_Int (Count),
1253 C_Int (Boolean'Pos (State))) = Curses_Err then
1254 raise Curses_Exception;
1256 end Change_Lines_Status;
1258 procedure Touch (Win : in Window := Standard_Window)
1261 X : Column_Position;
1263 Get_Size (Win, Y, X);
1264 Change_Lines_Status (Win, 0, Positive (Y), True);
1267 procedure Untouch (Win : in Window := Standard_Window)
1270 X : Column_Position;
1272 Get_Size (Win, Y, X);
1273 Change_Lines_Status (Win, 0, Positive (Y), False);
1276 procedure Touch (Win : in Window := Standard_Window;
1277 Start : in Line_Position;
1278 Count : in Positive)
1281 Change_Lines_Status (Win, Start, Count, True);
1285 (Win : Window := Standard_Window;
1286 Line : Line_Position) return Boolean
1288 function WLineTouched (W : Window; L : C_Int) return Curses_Bool;
1289 pragma Import (C, WLineTouched, "is_linetouched");
1291 if WLineTouched (Win, C_Int (Line)) = Curses_Bool_False then
1299 (Win : Window := Standard_Window) return Boolean
1301 function WWinTouched (W : Window) return Curses_Bool;
1302 pragma Import (C, WWinTouched, "is_wintouched");
1304 if WWinTouched (Win) = Curses_Bool_False then
1310 ------------------------------------------------------------------------------
1312 (Source_Window : in Window;
1313 Destination_Window : in Window;
1314 Source_Top_Row : in Line_Position;
1315 Source_Left_Column : in Column_Position;
1316 Destination_Top_Row : in Line_Position;
1317 Destination_Left_Column : in Column_Position;
1318 Destination_Bottom_Row : in Line_Position;
1319 Destination_Right_Column : in Column_Position;
1320 Non_Destructive_Mode : in Boolean := True)
1322 function Copywin (Src : Window;
1330 Ndm : C_Int) return C_Int;
1331 pragma Import (C, Copywin, "copywin");
1333 if Copywin (Source_Window,
1335 C_Int (Source_Top_Row),
1336 C_Int (Source_Left_Column),
1337 C_Int (Destination_Top_Row),
1338 C_Int (Destination_Left_Column),
1339 C_Int (Destination_Bottom_Row),
1340 C_Int (Destination_Right_Column),
1341 Boolean'Pos (Non_Destructive_Mode)
1343 raise Curses_Exception;
1348 (Source_Window : in Window;
1349 Destination_Window : in Window)
1351 function Overwrite (Src : Window; Dst : Window) return C_Int;
1352 pragma Import (C, Overwrite, "overwrite");
1354 if Overwrite (Source_Window, Destination_Window) = Curses_Err then
1355 raise Curses_Exception;
1360 (Source_Window : in Window;
1361 Destination_Window : in Window)
1363 function Overlay (Src : Window; Dst : Window) return C_Int;
1364 pragma Import (C, Overlay, "overlay");
1366 if Overlay (Source_Window, Destination_Window) = Curses_Err then
1367 raise Curses_Exception;
1371 ------------------------------------------------------------------------------
1372 procedure Insert_Delete_Lines
1373 (Win : in Window := Standard_Window;
1374 Lines : in Integer := 1) -- default is to insert one line above
1376 function Winsdelln (W : Window; N : C_Int) return C_Int;
1377 pragma Import (C, Winsdelln, "winsdelln");
1379 if Winsdelln (Win, C_Int (Lines)) = Curses_Err then
1380 raise Curses_Exception;
1382 end Insert_Delete_Lines;
1384 procedure Delete_Line (Win : in Window := Standard_Window)
1387 Insert_Delete_Lines (Win, -1);
1390 procedure Insert_Line (Win : in Window := Standard_Window)
1393 Insert_Delete_Lines (Win, 1);
1395 ------------------------------------------------------------------------------
1398 (Win : in Window := Standard_Window;
1399 Number_Of_Lines : out Line_Count;
1400 Number_Of_Columns : out Column_Count)
1402 -- Please note: in ncurses they are one off.
1403 -- This might be different in other implementations of curses
1404 Y : constant C_Int := C_Int (W_Get_Short (Win, Offset_maxy))
1405 + C_Int (Offset_XY);
1406 X : constant C_Int := C_Int (W_Get_Short (Win, Offset_maxx))
1407 + C_Int (Offset_XY);
1409 Number_Of_Lines := Line_Count (Y);
1410 Number_Of_Columns := Column_Count (X);
1413 procedure Get_Window_Position
1414 (Win : in Window := Standard_Window;
1415 Top_Left_Line : out Line_Position;
1416 Top_Left_Column : out Column_Position)
1418 Y : constant C_Short := W_Get_Short (Win, Offset_begy);
1419 X : constant C_Short := W_Get_Short (Win, Offset_begx);
1421 Top_Left_Line := Line_Position (Y);
1422 Top_Left_Column := Column_Position (X);
1423 end Get_Window_Position;
1425 procedure Get_Cursor_Position
1426 (Win : in Window := Standard_Window;
1427 Line : out Line_Position;
1428 Column : out Column_Position)
1430 Y : constant C_Short := W_Get_Short (Win, Offset_cury);
1431 X : constant C_Short := W_Get_Short (Win, Offset_curx);
1433 Line := Line_Position (Y);
1434 Column := Column_Position (X);
1435 end Get_Cursor_Position;
1437 procedure Get_Origin_Relative_To_Parent
1439 Top_Left_Line : out Line_Position;
1440 Top_Left_Column : out Column_Position;
1441 Is_Not_A_Subwindow : out Boolean)
1443 Y : constant C_Int := W_Get_Int (Win, Offset_pary);
1444 X : constant C_Int := W_Get_Int (Win, Offset_parx);
1447 Top_Left_Line := Line_Position'Last;
1448 Top_Left_Column := Column_Position'Last;
1449 Is_Not_A_Subwindow := True;
1451 Top_Left_Line := Line_Position (Y);
1452 Top_Left_Column := Column_Position (X);
1453 Is_Not_A_Subwindow := False;
1455 end Get_Origin_Relative_To_Parent;
1456 ------------------------------------------------------------------------------
1457 function New_Pad (Lines : Line_Count;
1458 Columns : Column_Count) return Window
1460 function Newpad (Lines : C_Int; Columns : C_Int) return Window;
1461 pragma Import (C, Newpad, "newpad");
1465 W := Newpad (C_Int (Lines), C_Int (Columns));
1466 if W = Null_Window then
1467 raise Curses_Exception;
1474 Number_Of_Lines : Line_Count;
1475 Number_Of_Columns : Column_Count;
1476 First_Line_Position : Line_Position;
1477 First_Column_Position : Column_Position) return Window
1481 Number_Of_Lines : C_Int;
1482 Number_Of_Columns : C_Int;
1483 First_Line_Position : C_Int;
1484 First_Column_Position : C_Int) return Window;
1485 pragma Import (C, Subpad, "subpad");
1490 C_Int (Number_Of_Lines),
1491 C_Int (Number_Of_Columns),
1492 C_Int (First_Line_Position),
1493 C_Int (First_Column_Position));
1494 if W = Null_Window then
1495 raise Curses_Exception;
1502 Source_Top_Row : in Line_Position;
1503 Source_Left_Column : in Column_Position;
1504 Destination_Top_Row : in Line_Position;
1505 Destination_Left_Column : in Column_Position;
1506 Destination_Bottom_Row : in Line_Position;
1507 Destination_Right_Column : in Column_Position)
1511 Source_Top_Row : C_Int;
1512 Source_Left_Column : C_Int;
1513 Destination_Top_Row : C_Int;
1514 Destination_Left_Column : C_Int;
1515 Destination_Bottom_Row : C_Int;
1516 Destination_Right_Column : C_Int) return C_Int;
1517 pragma Import (C, Prefresh, "prefresh");
1520 C_Int (Source_Top_Row),
1521 C_Int (Source_Left_Column),
1522 C_Int (Destination_Top_Row),
1523 C_Int (Destination_Left_Column),
1524 C_Int (Destination_Bottom_Row),
1525 C_Int (Destination_Right_Column)) = Curses_Err then
1526 raise Curses_Exception;
1530 procedure Refresh_Without_Update
1532 Source_Top_Row : in Line_Position;
1533 Source_Left_Column : in Column_Position;
1534 Destination_Top_Row : in Line_Position;
1535 Destination_Left_Column : in Column_Position;
1536 Destination_Bottom_Row : in Line_Position;
1537 Destination_Right_Column : in Column_Position)
1539 function Pnoutrefresh
1541 Source_Top_Row : C_Int;
1542 Source_Left_Column : C_Int;
1543 Destination_Top_Row : C_Int;
1544 Destination_Left_Column : C_Int;
1545 Destination_Bottom_Row : C_Int;
1546 Destination_Right_Column : C_Int) return C_Int;
1547 pragma Import (C, Pnoutrefresh, "pnoutrefresh");
1549 if Pnoutrefresh (Pad,
1550 C_Int (Source_Top_Row),
1551 C_Int (Source_Left_Column),
1552 C_Int (Destination_Top_Row),
1553 C_Int (Destination_Left_Column),
1554 C_Int (Destination_Bottom_Row),
1555 C_Int (Destination_Right_Column)) = Curses_Err then
1556 raise Curses_Exception;
1558 end Refresh_Without_Update;
1560 procedure Add_Character_To_Pad_And_Echo_It
1562 Ch : in Attributed_Character)
1564 function Pechochar (Pad : Window; Ch : C_Chtype)
1566 pragma Import (C, Pechochar, "pechochar");
1568 if Pechochar (Pad, AttrChar_To_Chtype (Ch)) = Curses_Err then
1569 raise Curses_Exception;
1571 end Add_Character_To_Pad_And_Echo_It;
1573 procedure Add_Character_To_Pad_And_Echo_It
1578 Add_Character_To_Pad_And_Echo_It
1580 Attributed_Character'(Ch => Ch,
1581 Color => Color_Pair'First,
1582 Attr => Normal_Video));
1583 end Add_Character_To_Pad_And_Echo_It;
1584 ------------------------------------------------------------------------------
1585 procedure Scroll (Win : in Window := Standard_Window;
1586 Amount : in Integer := 1)
1588 function Wscrl (Win : Window; N : C_Int) return C_Int;
1589 pragma Import (C, Wscrl, "wscrl");
1592 if Wscrl (Win, C_Int (Amount)) = Curses_Err then
1593 raise Curses_Exception;
1597 ------------------------------------------------------------------------------
1598 procedure Delete_Character (Win : in Window := Standard_Window)
1600 function Wdelch (Win : Window) return C_Int;
1601 pragma Import (C, Wdelch, "wdelch");
1603 if Wdelch (Win) = Curses_Err then
1604 raise Curses_Exception;
1606 end Delete_Character;
1608 procedure Delete_Character
1609 (Win : in Window := Standard_Window;
1610 Line : in Line_Position;
1611 Column : in Column_Position)
1613 function Mvwdelch (Win : Window;
1615 Col : C_Int) return C_Int;
1616 pragma Import (C, Mvwdelch, "mvwdelch");
1618 if Mvwdelch (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
1619 raise Curses_Exception;
1621 end Delete_Character;
1622 ------------------------------------------------------------------------------
1623 function Peek (Win : Window := Standard_Window)
1624 return Attributed_Character
1626 function Winch (Win : Window) return C_Chtype;
1627 pragma Import (C, Winch, "winch");
1629 return Chtype_To_AttrChar (Winch (Win));
1633 (Win : Window := Standard_Window;
1634 Line : Line_Position;
1635 Column : Column_Position) return Attributed_Character
1637 function Mvwinch (Win : Window;
1639 Col : C_Int) return C_Chtype;
1640 pragma Import (C, Mvwinch, "mvwinch");
1642 return Chtype_To_AttrChar (Mvwinch (Win, C_Int (Line), C_Int (Column)));
1644 ------------------------------------------------------------------------------
1645 procedure Insert (Win : in Window := Standard_Window;
1646 Ch : in Attributed_Character)
1648 function Winsch (Win : Window; Ch : C_Chtype) return C_Int;
1649 pragma Import (C, Winsch, "winsch");
1651 if Winsch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
1652 raise Curses_Exception;
1657 (Win : in Window := Standard_Window;
1658 Line : in Line_Position;
1659 Column : in Column_Position;
1660 Ch : in Attributed_Character)
1662 function Mvwinsch (Win : Window;
1665 Ch : C_Chtype) return C_Int;
1666 pragma Import (C, Mvwinsch, "mvwinsch");
1671 AttrChar_To_Chtype (Ch)) = Curses_Err then
1672 raise Curses_Exception;
1675 ------------------------------------------------------------------------------
1676 procedure Insert (Win : in Window := Standard_Window;
1678 Len : in Integer := -1)
1680 function Winsnstr (Win : Window;
1682 Len : Integer := -1) return C_Int;
1683 pragma Import (C, Winsnstr, "winsnstr");
1685 Txt : char_array (0 .. Str'Length);
1688 To_C (Str, Txt, Length);
1689 if Winsnstr (Win, Txt, Len) = Curses_Err then
1690 raise Curses_Exception;
1695 (Win : in Window := Standard_Window;
1696 Line : in Line_Position;
1697 Column : in Column_Position;
1699 Len : in Integer := -1)
1701 function Mvwinsnstr (Win : Window;
1705 Len : C_Int) return C_Int;
1706 pragma Import (C, Mvwinsnstr, "mvwinsnstr");
1708 Txt : char_array (0 .. Str'Length);
1711 To_C (Str, Txt, Length);
1712 if Mvwinsnstr (Win, C_Int (Line), C_Int (Column), Txt, C_Int (Len))
1714 raise Curses_Exception;
1717 ------------------------------------------------------------------------------
1718 procedure Peek (Win : in Window := Standard_Window;
1720 Len : in Integer := -1)
1722 function Winnstr (Win : Window;
1724 Len : C_Int) return C_Int;
1725 pragma Import (C, Winnstr, "winnstr");
1728 Txt : char_array (0 .. Str'Length);
1734 if N > Str'Length then
1735 raise Constraint_Error;
1737 Txt (0) := Interfaces.C.char'First;
1738 if Winnstr (Win, Txt, C_Int (N)) = Curses_Err then
1739 raise Curses_Exception;
1741 To_Ada (Txt, Str, Cnt, True);
1742 if Cnt < Str'Length then
1743 Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
1748 (Win : in Window := Standard_Window;
1749 Line : in Line_Position;
1750 Column : in Column_Position;
1752 Len : in Integer := -1)
1755 Move_Cursor (Win, Line, Column);
1756 Peek (Win, Str, Len);
1758 ------------------------------------------------------------------------------
1760 (Win : in Window := Standard_Window;
1761 Str : out Attributed_String;
1762 Len : in Integer := -1)
1764 function Winchnstr (Win : Window;
1765 Str : chtype_array; -- out
1766 Len : C_Int) return C_Int;
1767 pragma Import (C, Winchnstr, "winchnstr");
1770 Txt : constant chtype_array (0 .. Str'Length)
1771 := (0 => Default_Character);
1777 if N > Str'Length then
1778 raise Constraint_Error;
1780 if Winchnstr (Win, Txt, C_Int (N)) = Curses_Err then
1781 raise Curses_Exception;
1783 for To in Str'Range loop
1784 exit when Txt (size_t (Cnt)) = Default_Character;
1785 Str (To) := Txt (size_t (Cnt));
1788 if Cnt < Str'Length then
1789 Str ((Str'First + Cnt) .. Str'Last) :=
1790 (others => (Ch => ' ',
1791 Color => Color_Pair'First,
1792 Attr => Normal_Video));
1797 (Win : in Window := Standard_Window;
1798 Line : in Line_Position;
1799 Column : in Column_Position;
1800 Str : out Attributed_String;
1801 Len : in Integer := -1)
1804 Move_Cursor (Win, Line, Column);
1805 Peek (Win, Str, Len);
1807 ------------------------------------------------------------------------------
1808 procedure Get (Win : in Window := Standard_Window;
1810 Len : in Integer := -1)
1812 function Wgetnstr (Win : Window;
1814 Len : C_Int) return C_Int;
1815 pragma Import (C, Wgetnstr, "wgetnstr");
1818 Txt : char_array (0 .. Str'Length);
1824 if N > Str'Length then
1825 raise Constraint_Error;
1827 Txt (0) := Interfaces.C.char'First;
1828 if Wgetnstr (Win, Txt, C_Int (N)) = Curses_Err then
1829 raise Curses_Exception;
1831 To_Ada (Txt, Str, Cnt, True);
1832 if Cnt < Str'Length then
1833 Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
1838 (Win : in Window := Standard_Window;
1839 Line : in Line_Position;
1840 Column : in Column_Position;
1842 Len : in Integer := -1)
1845 Move_Cursor (Win, Line, Column);
1846 Get (Win, Str, Len);
1848 ------------------------------------------------------------------------------
1849 procedure Init_Soft_Label_Keys
1850 (Format : in Soft_Label_Key_Format := Three_Two_Three)
1852 function Slk_Init (Fmt : C_Int) return C_Int;
1853 pragma Import (C, Slk_Init, "slk_init");
1855 if Slk_Init (Soft_Label_Key_Format'Pos (Format)) = Curses_Err then
1856 raise Curses_Exception;
1858 end Init_Soft_Label_Keys;
1860 procedure Set_Soft_Label_Key (Label : in Label_Number;
1862 Fmt : in Label_Justification := Left)
1864 function Slk_Set (Label : C_Int;
1866 Fmt : C_Int) return C_Int;
1867 pragma Import (C, Slk_Set, "slk_set");
1869 Txt : char_array (0 .. Text'Length);
1872 To_C (Text, Txt, Len);
1873 if Slk_Set (C_Int (Label), Txt,
1874 C_Int (Label_Justification'Pos (Fmt))) = Curses_Err then
1875 raise Curses_Exception;
1877 end Set_Soft_Label_Key;
1879 procedure Refresh_Soft_Label_Keys
1881 function Slk_Refresh return C_Int;
1882 pragma Import (C, Slk_Refresh, "slk_refresh");
1884 if Slk_Refresh = Curses_Err then
1885 raise Curses_Exception;
1887 end Refresh_Soft_Label_Keys;
1889 procedure Refresh_Soft_Label_Keys_Without_Update
1891 function Slk_Noutrefresh return C_Int;
1892 pragma Import (C, Slk_Noutrefresh, "slk_noutrefresh");
1894 if Slk_Noutrefresh = Curses_Err then
1895 raise Curses_Exception;
1897 end Refresh_Soft_Label_Keys_Without_Update;
1899 procedure Get_Soft_Label_Key (Label : in Label_Number;
1902 function Slk_Label (Label : C_Int) return chars_ptr;
1903 pragma Import (C, Slk_Label, "slk_label");
1905 Fill_String (Slk_Label (C_Int (Label)), Text);
1906 end Get_Soft_Label_Key;
1908 function Get_Soft_Label_Key (Label : in Label_Number) return String
1910 function Slk_Label (Label : C_Int) return chars_ptr;
1911 pragma Import (C, Slk_Label, "slk_label");
1913 return Fill_String (Slk_Label (C_Int (Label)));
1914 end Get_Soft_Label_Key;
1916 procedure Clear_Soft_Label_Keys
1918 function Slk_Clear return C_Int;
1919 pragma Import (C, Slk_Clear, "slk_clear");
1921 if Slk_Clear = Curses_Err then
1922 raise Curses_Exception;
1924 end Clear_Soft_Label_Keys;
1926 procedure Restore_Soft_Label_Keys
1928 function Slk_Restore return C_Int;
1929 pragma Import (C, Slk_Restore, "slk_restore");
1931 if Slk_Restore = Curses_Err then
1932 raise Curses_Exception;
1934 end Restore_Soft_Label_Keys;
1936 procedure Touch_Soft_Label_Keys
1938 function Slk_Touch return C_Int;
1939 pragma Import (C, Slk_Touch, "slk_touch");
1941 if Slk_Touch = Curses_Err then
1942 raise Curses_Exception;
1944 end Touch_Soft_Label_Keys;
1946 procedure Switch_Soft_Label_Key_Attributes
1947 (Attr : in Character_Attribute_Set;
1948 On : in Boolean := True)
1950 function Slk_Attron (Ch : C_Chtype) return C_Int;
1951 pragma Import (C, Slk_Attron, "slk_attron");
1952 function Slk_Attroff (Ch : C_Chtype) return C_Int;
1953 pragma Import (C, Slk_Attroff, "slk_attroff");
1956 Ch : constant Attributed_Character := (Ch => Character'First,
1958 Color => Color_Pair'First);
1961 Err := Slk_Attron (AttrChar_To_Chtype (Ch));
1963 Err := Slk_Attroff (AttrChar_To_Chtype (Ch));
1965 if Err = Curses_Err then
1966 raise Curses_Exception;
1968 end Switch_Soft_Label_Key_Attributes;
1970 procedure Set_Soft_Label_Key_Attributes
1971 (Attr : in Character_Attribute_Set := Normal_Video;
1972 Color : in Color_Pair := Color_Pair'First)
1974 function Slk_Attrset (Ch : C_Chtype) return C_Int;
1975 pragma Import (C, Slk_Attrset, "slk_attrset");
1977 Ch : constant Attributed_Character := (Ch => Character'First,
1981 if Slk_Attrset (AttrChar_To_Chtype (Ch)) = Curses_Err then
1982 raise Curses_Exception;
1984 end Set_Soft_Label_Key_Attributes;
1986 function Get_Soft_Label_Key_Attributes return Character_Attribute_Set
1988 function Slk_Attr return C_Chtype;
1989 pragma Import (C, Slk_Attr, "slk_attr");
1991 Attr : constant C_Chtype := Slk_Attr;
1993 return Chtype_To_AttrChar (Attr).Attr;
1994 end Get_Soft_Label_Key_Attributes;
1996 function Get_Soft_Label_Key_Attributes return Color_Pair
1998 function Slk_Attr return C_Chtype;
1999 pragma Import (C, Slk_Attr, "slk_attr");
2001 Attr : constant C_Chtype := Slk_Attr;
2003 return Chtype_To_AttrChar (Attr).Color;
2004 end Get_Soft_Label_Key_Attributes;
2006 procedure Set_Soft_Label_Key_Color (Pair : in Color_Pair)
2008 function Slk_Color (Color : in C_Short) return C_Int;
2009 pragma Import (C, Slk_Color, "slk_color");
2011 if Slk_Color (C_Short (Pair)) = Curses_Err then
2012 raise Curses_Exception;
2014 end Set_Soft_Label_Key_Color;
2016 ------------------------------------------------------------------------------
2017 procedure Enable_Key (Key : in Special_Key_Code;
2018 Enable : in Boolean := True)
2020 function Keyok (Keycode : C_Int;
2021 On_Off : Curses_Bool) return C_Int;
2022 pragma Import (C, Keyok, "keyok");
2024 if Keyok (C_Int (Key), Curses_Bool (Boolean'Pos (Enable)))
2026 raise Curses_Exception;
2029 ------------------------------------------------------------------------------
2030 procedure Define_Key (Definition : in String;
2031 Key : in Special_Key_Code)
2033 function Defkey (Def : char_array;
2034 Key : C_Int) return C_Int;
2035 pragma Import (C, Defkey, "define_key");
2037 Txt : char_array (0 .. Definition'Length);
2040 To_C (Definition, Txt, Length);
2041 if Defkey (Txt, C_Int (Key)) = Curses_Err then
2042 raise Curses_Exception;
2045 ------------------------------------------------------------------------------
2046 procedure Un_Control (Ch : in Attributed_Character;
2049 function Unctrl (Ch : C_Chtype) return chars_ptr;
2050 pragma Import (C, Unctrl, "unctrl");
2052 Fill_String (Unctrl (AttrChar_To_Chtype (Ch)), Str);
2055 function Un_Control (Ch : in Attributed_Character) return String
2057 function Unctrl (Ch : C_Chtype) return chars_ptr;
2058 pragma Import (C, Unctrl, "unctrl");
2060 return Fill_String (Unctrl (AttrChar_To_Chtype (Ch)));
2063 procedure Delay_Output (Msecs : in Natural)
2065 function Delayoutput (Msecs : C_Int) return C_Int;
2066 pragma Import (C, Delayoutput, "delay_output");
2068 if Delayoutput (C_Int (Msecs)) = Curses_Err then
2069 raise Curses_Exception;
2073 procedure Flush_Input
2075 function Flushinp return C_Int;
2076 pragma Import (C, Flushinp, "flushinp");
2078 if Flushinp = Curses_Err then -- docu says that never happens, but...
2079 raise Curses_Exception;
2082 ------------------------------------------------------------------------------
2083 function Baudrate return Natural
2085 function Baud return C_Int;
2086 pragma Import (C, Baud, "baudrate");
2088 return Natural (Baud);
2091 function Erase_Character return Character
2093 function Erasechar return C_Int;
2094 pragma Import (C, Erasechar, "erasechar");
2096 return Character'Val (Erasechar);
2097 end Erase_Character;
2099 function Kill_Character return Character
2101 function Killchar return C_Int;
2102 pragma Import (C, Killchar, "killchar");
2104 return Character'Val (Killchar);
2107 function Has_Insert_Character return Boolean
2109 function Has_Ic return Curses_Bool;
2110 pragma Import (C, Has_Ic, "has_ic");
2112 if Has_Ic = Curses_Bool_False then
2117 end Has_Insert_Character;
2119 function Has_Insert_Line return Boolean
2121 function Has_Il return Curses_Bool;
2122 pragma Import (C, Has_Il, "has_il");
2124 if Has_Il = Curses_Bool_False then
2129 end Has_Insert_Line;
2131 function Supported_Attributes return Character_Attribute_Set
2133 function Termattrs return C_Chtype;
2134 pragma Import (C, Termattrs, "termattrs");
2136 Ch : constant Attributed_Character := Chtype_To_AttrChar (Termattrs);
2139 end Supported_Attributes;
2141 procedure Long_Name (Name : out String)
2143 function Longname return chars_ptr;
2144 pragma Import (C, Longname, "longname");
2146 Fill_String (Longname, Name);
2149 function Long_Name return String
2151 function Longname return chars_ptr;
2152 pragma Import (C, Longname, "longname");
2154 return Fill_String (Longname);
2157 procedure Terminal_Name (Name : out String)
2159 function Termname return chars_ptr;
2160 pragma Import (C, Termname, "termname");
2162 Fill_String (Termname, Name);
2165 function Terminal_Name return String
2167 function Termname return chars_ptr;
2168 pragma Import (C, Termname, "termname");
2170 return Fill_String (Termname);
2172 ------------------------------------------------------------------------------
2173 procedure Init_Pair (Pair : in Redefinable_Color_Pair;
2174 Fore : in Color_Number;
2175 Back : in Color_Number)
2177 function Initpair (Pair : C_Short;
2179 Back : C_Short) return C_Int;
2180 pragma Import (C, Initpair, "init_pair");
2182 if Integer (Pair) >= Number_Of_Color_Pairs then
2183 raise Constraint_Error;
2185 if Integer (Fore) >= Number_Of_Colors or else
2186 Integer (Back) >= Number_Of_Colors then raise Constraint_Error;
2188 if Initpair (C_Short (Pair), C_Short (Fore), C_Short (Back))
2190 raise Curses_Exception;
2194 procedure Pair_Content (Pair : in Color_Pair;
2195 Fore : out Color_Number;
2196 Back : out Color_Number)
2198 type C_Short_Access is access all C_Short;
2199 function Paircontent (Pair : C_Short;
2200 Fp : C_Short_Access;
2201 Bp : C_Short_Access) return C_Int;
2202 pragma Import (C, Paircontent, "pair_content");
2204 F, B : aliased C_Short;
2206 if Paircontent (C_Short (Pair), F'Access, B'Access) = Curses_Err then
2207 raise Curses_Exception;
2209 Fore := Color_Number (F);
2210 Back := Color_Number (B);
2214 function Has_Colors return Boolean
2216 function Hascolors return Curses_Bool;
2217 pragma Import (C, Hascolors, "has_colors");
2219 if Hascolors = Curses_Bool_False then
2226 procedure Init_Color (Color : in Color_Number;
2228 Green : in RGB_Value;
2229 Blue : in RGB_Value)
2231 function Initcolor (Col : C_Short;
2234 Blue : C_Short) return C_Int;
2235 pragma Import (C, Initcolor, "init_color");
2237 if Initcolor (C_Short (Color), C_Short (Red), C_Short (Green),
2238 C_Short (Blue)) = Curses_Err then
2239 raise Curses_Exception;
2243 function Can_Change_Color return Boolean
2245 function Canchangecolor return Curses_Bool;
2246 pragma Import (C, Canchangecolor, "can_change_color");
2248 if Canchangecolor = Curses_Bool_False then
2253 end Can_Change_Color;
2255 procedure Color_Content (Color : in Color_Number;
2256 Red : out RGB_Value;
2257 Green : out RGB_Value;
2258 Blue : out RGB_Value)
2260 type C_Short_Access is access all C_Short;
2262 function Colorcontent (Color : C_Short; R, G, B : C_Short_Access)
2264 pragma Import (C, Colorcontent, "color_content");
2266 R, G, B : aliased C_Short;
2268 if Colorcontent (C_Short (Color), R'Access, G'Access, B'Access) =
2270 raise Curses_Exception;
2272 Red := RGB_Value (R);
2273 Green := RGB_Value (G);
2274 Blue := RGB_Value (B);
2278 ------------------------------------------------------------------------------
2279 procedure Save_Curses_Mode (Mode : in Curses_Mode)
2281 function Def_Prog_Mode return C_Int;
2282 pragma Import (C, Def_Prog_Mode, "def_prog_mode");
2283 function Def_Shell_Mode return C_Int;
2284 pragma Import (C, Def_Shell_Mode, "def_shell_mode");
2289 when Curses => Err := Def_Prog_Mode;
2290 when Shell => Err := Def_Shell_Mode;
2292 if Err = Curses_Err then
2293 raise Curses_Exception;
2295 end Save_Curses_Mode;
2297 procedure Reset_Curses_Mode (Mode : in Curses_Mode)
2299 function Reset_Prog_Mode return C_Int;
2300 pragma Import (C, Reset_Prog_Mode, "reset_prog_mode");
2301 function Reset_Shell_Mode return C_Int;
2302 pragma Import (C, Reset_Shell_Mode, "reset_shell_mode");
2307 when Curses => Err := Reset_Prog_Mode;
2308 when Shell => Err := Reset_Shell_Mode;
2310 if Err = Curses_Err then
2311 raise Curses_Exception;
2313 end Reset_Curses_Mode;
2315 procedure Save_Terminal_State
2317 function Savetty return C_Int;
2318 pragma Import (C, Savetty, "savetty");
2320 if Savetty = Curses_Err then
2321 raise Curses_Exception;
2323 end Save_Terminal_State;
2325 procedure Reset_Terminal_State
2327 function Resetty return C_Int;
2328 pragma Import (C, Resetty, "resetty");
2330 if Resetty = Curses_Err then
2331 raise Curses_Exception;
2333 end Reset_Terminal_State;
2335 procedure Rip_Off_Lines (Lines : in Integer;
2336 Proc : in Stdscr_Init_Proc)
2338 function Ripoffline (Lines : C_Int;
2339 Proc : Stdscr_Init_Proc) return C_Int;
2340 pragma Import (C, Ripoffline, "_nc_ripoffline");
2342 if Ripoffline (C_Int (Lines), Proc) = Curses_Err then
2343 raise Curses_Exception;
2347 procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility)
2349 function Curs_Set (Curs : C_Int) return C_Int;
2350 pragma Import (C, Curs_Set, "curs_set");
2354 Res := Curs_Set (Cursor_Visibility'Pos (Visibility));
2355 if Res /= Curses_Err then
2356 Visibility := Cursor_Visibility'Val (Res);
2358 end Set_Cursor_Visibility;
2360 procedure Nap_Milli_Seconds (Ms : in Natural)
2362 function Napms (Ms : C_Int) return C_Int;
2363 pragma Import (C, Napms, "napms");
2365 if Napms (C_Int (Ms)) = Curses_Err then
2366 raise Curses_Exception;
2368 end Nap_Milli_Seconds;
2369 ------------------------------------------------------------------------------
2371 function Standard_Window return Window
2374 pragma Import (C, Stdscr, "stdscr");
2377 end Standard_Window;
2379 function Lines return Line_Count
2382 pragma Import (C, C_Lines, "LINES");
2384 return Line_Count (C_Lines);
2387 function Columns return Column_Count
2390 pragma Import (C, C_Columns, "COLS");
2392 return Column_Count (C_Columns);
2395 function Tab_Size return Natural
2398 pragma Import (C, C_Tab_Size, "TABSIZE");
2400 return Natural (C_Tab_Size);
2403 function Number_Of_Colors return Natural
2405 C_Number_Of_Colors : C_Int;
2406 pragma Import (C, C_Number_Of_Colors, "COLORS");
2408 return Natural (C_Number_Of_Colors);
2409 end Number_Of_Colors;
2411 function Number_Of_Color_Pairs return Natural
2413 C_Number_Of_Color_Pairs : C_Int;
2414 pragma Import (C, C_Number_Of_Color_Pairs, "COLOR_PAIRS");
2416 return Natural (C_Number_Of_Color_Pairs);
2417 end Number_Of_Color_Pairs;
2418 ------------------------------------------------------------------------------
2419 procedure Transform_Coordinates
2420 (W : in Window := Standard_Window;
2421 Line : in out Line_Position;
2422 Column : in out Column_Position;
2423 Dir : in Transform_Direction := From_Screen)
2425 type Int_Access is access all C_Int;
2426 function Transform (W : Window;
2428 Dir : Curses_Bool) return C_Int;
2429 pragma Import (C, Transform, "wmouse_trafo");
2431 X : aliased C_Int := C_Int (Column);
2432 Y : aliased C_Int := C_Int (Line);
2433 D : Curses_Bool := Curses_Bool_False;
2436 if Dir = To_Screen then
2439 R := Transform (W, Y'Access, X'Access, D);
2440 if R = Curses_False then
2441 raise Curses_Exception;
2443 Line := Line_Position (Y);
2444 Column := Column_Position (X);
2446 end Transform_Coordinates;
2447 ------------------------------------------------------------------------------
2448 procedure Use_Default_Colors is
2449 function C_Use_Default_Colors return C_Int;
2450 pragma Import (C, C_Use_Default_Colors, "use_default_colors");
2451 Err : constant C_Int := C_Use_Default_Colors;
2453 if Err = Curses_Err then
2454 raise Curses_Exception;
2456 end Use_Default_Colors;
2458 procedure Assume_Default_Colors (Fore : Color_Number := Default_Color;
2459 Back : Color_Number := Default_Color)
2461 function C_Assume_Default_Colors (Fore : C_Int;
2462 Back : C_Int) return C_Int;
2463 pragma Import (C, C_Assume_Default_Colors, "assume_default_colors");
2465 Err : constant C_Int := C_Assume_Default_Colors (C_Int (Fore),
2468 if Err = Curses_Err then
2469 raise Curses_Exception;
2471 end Assume_Default_Colors;
2472 ------------------------------------------------------------------------------
2473 function Curses_Version return String
2475 function curses_versionC return chars_ptr;
2476 pragma Import (C, curses_versionC, "curses_version");
2477 Result : constant chars_ptr := curses_versionC;
2479 return Fill_String (Result);
2481 ------------------------------------------------------------------------------
2482 function Use_Extended_Names (Enable : Boolean) return Boolean
2484 function use_extended_namesC (e : Curses_Bool) return C_Int;
2485 pragma Import (C, use_extended_namesC, "use_extended_names");
2487 Res : constant C_Int :=
2488 use_extended_namesC (Curses_Bool (Boolean'Pos (Enable)));
2490 if Res = C_Int (Curses_Bool_False) then
2495 end Use_Extended_Names;
2496 ------------------------------------------------------------------------------
2497 procedure Screen_Dump_To_File (Filename : in String)
2499 function scr_dump (f : char_array) return C_Int;
2500 pragma Import (C, scr_dump, "scr_dump");
2501 Txt : char_array (0 .. Filename'Length);
2504 To_C (Filename, Txt, Length);
2505 if Curses_Err = scr_dump (Txt) then
2506 raise Curses_Exception;
2508 end Screen_Dump_To_File;
2510 procedure Screen_Restore_From_File (Filename : in String)
2512 function scr_restore (f : char_array) return C_Int;
2513 pragma Import (C, scr_restore, "scr_restore");
2514 Txt : char_array (0 .. Filename'Length);
2517 To_C (Filename, Txt, Length);
2518 if Curses_Err = scr_restore (Txt) then
2519 raise Curses_Exception;
2521 end Screen_Restore_From_File;
2523 procedure Screen_Init_From_File (Filename : in String)
2525 function scr_init (f : char_array) return C_Int;
2526 pragma Import (C, scr_init, "scr_init");
2527 Txt : char_array (0 .. Filename'Length);
2530 To_C (Filename, Txt, Length);
2531 if Curses_Err = scr_init (Txt) then
2532 raise Curses_Exception;
2534 end Screen_Init_From_File;
2536 procedure Screen_Set_File (Filename : in String)
2538 function scr_set (f : char_array) return C_Int;
2539 pragma Import (C, scr_set, "scr_set");
2540 Txt : char_array (0 .. Filename'Length);
2543 To_C (Filename, Txt, Length);
2544 if Curses_Err = scr_set (Txt) then
2545 raise Curses_Exception;
2547 end Screen_Set_File;
2548 ------------------------------------------------------------------------------
2549 procedure Resize (Win : Window := Standard_Window;
2550 Number_Of_Lines : Line_Count;
2551 Number_Of_Columns : Column_Count) is
2552 function wresize (win : Window;
2554 columns : C_Int) return C_Int;
2555 pragma Import (C, wresize);
2558 C_Int (Number_Of_Lines),
2559 C_Int (Number_Of_Columns)) = Curses_Err then
2560 raise Curses_Exception;
2563 ------------------------------------------------------------------------------
2565 end Terminal_Interface.Curses;