1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding --
5 -- Terminal_Interface.Curses --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 1998 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 -- Binding Version 01.00
40 ------------------------------------------------------------------------------
43 with Terminal_Interface.Curses.Aux;
44 with Interfaces.C; use Interfaces.C;
45 with Interfaces.C.Strings; use Interfaces.C.Strings;
46 with Interfaces.C.Pointers;
47 with Ada.Characters.Handling; use Ada.Characters.Handling;
48 with Ada.Strings.Fixed;
49 with Ada.Unchecked_Conversion;
51 package body Terminal_Interface.Curses is
54 use type System.Bit_Order;
56 package ASF renames Ada.Strings.Fixed;
58 type chtype_array is array (size_t range <>)
59 of aliased Attributed_Character;
60 pragma Convention (C, chtype_array);
62 ------------------------------------------------------------------------------
65 function W_Get_Element (Win : in Window;
66 Offset : in Natural) return Element;
68 function W_Get_Element (Win : in Window;
69 Offset : in Natural) return Element is
70 type E_Array is array (Natural range <>) of aliased Element;
71 package C_E_Array is new
72 Interfaces.C.Pointers (Natural, Element, E_Array, Element'Val (0));
75 function To_Pointer is new
76 Ada.Unchecked_Conversion (Window, Pointer);
78 P : Pointer := To_Pointer (Win);
80 if Win = Null_Window then
81 raise Curses_Exception;
83 P := P + ptrdiff_t (Offset);
88 function W_Get_Int is new W_Get_Element (C_Int);
89 function W_Get_Short is new W_Get_Element (C_Short);
90 function W_Get_Byte is new W_Get_Element (Interfaces.C.unsigned_char);
92 function Get_Flag (Win : Window;
93 Offset : Natural) return Boolean;
95 function Get_Flag (Win : Window;
96 Offset : Natural) return Boolean
101 when 1 => Res := C_Int (W_Get_Byte (Win, Offset));
102 when 2 => Res := C_Int (W_Get_Short (Win, Offset));
103 when 4 => Res := C_Int (W_Get_Int (Win, Offset));
104 when others => raise Curses_Exception;
108 when 0 => return False;
109 when others => return True;
113 ------------------------------------------------------------------------------
114 function Key_Name (Key : in Real_Key_Code) return String
116 function Keyname (K : C_Int) return chars_ptr;
117 pragma Import (C, Keyname, "keyname");
121 if Key <= Character'Pos (Character'Last) then
122 Ch := Character'Val (Key);
123 if Is_Control (Ch) then
124 return Un_Control (Attributed_Character'(Ch => Ch,
125 Color => Color_Pair'First,
126 Attr => Normal_Video));
127 elsif Is_Graphic (Ch) then
138 return Fill_String (Keyname (C_Int (Key)));
142 procedure Key_Name (Key : in Real_Key_Code;
146 ASF.Move (Key_Name (Key), Name);
149 ------------------------------------------------------------------------------
150 procedure Init_Screen
152 function Initscr return Window;
153 pragma Import (C, Initscr, "initscr");
158 if W = Null_Window then
159 raise Curses_Exception;
163 procedure End_Windows
165 function Endwin return C_Int;
166 pragma Import (C, Endwin, "endwin");
168 if Endwin = Curses_Err then
169 raise Curses_Exception;
173 function Is_End_Window return Boolean
175 function Isendwin return Curses_Bool;
176 pragma Import (C, Isendwin, "isendwin");
178 if Isendwin = Curses_Bool_False then
184 ------------------------------------------------------------------------------
185 procedure Move_Cursor (Win : in Window := Standard_Window;
186 Line : in Line_Position;
187 Column : in Column_Position)
189 function Wmove (Win : Window;
193 pragma Import (C, Wmove, "wmove");
195 if Wmove (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
196 raise Curses_Exception;
199 ------------------------------------------------------------------------------
200 procedure Add (Win : in Window := Standard_Window;
201 Ch : in Attributed_Character)
203 function Waddch (W : Window;
204 Ch : C_Chtype) return C_Int;
205 pragma Import (C, Waddch, "waddch");
207 if Waddch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
208 raise Curses_Exception;
212 procedure Add (Win : in Window := Standard_Window;
217 Attributed_Character'(Ch => Ch,
218 Color => Color_Pair'First,
219 Attr => Normal_Video));
223 (Win : in Window := Standard_Window;
224 Line : in Line_Position;
225 Column : in Column_Position;
226 Ch : in Attributed_Character)
228 function mvwaddch (W : Window;
231 Ch : C_Chtype) return C_Int;
232 pragma Import (C, mvwaddch, "mvwaddch");
234 if mvwaddch (Win, C_Int (Line),
236 AttrChar_To_Chtype (Ch)) = Curses_Err then
237 raise Curses_Exception;
242 (Win : in Window := Standard_Window;
243 Line : in Line_Position;
244 Column : in Column_Position;
251 Attributed_Character'(Ch => Ch,
252 Color => Color_Pair'First,
253 Attr => Normal_Video));
256 procedure Add_With_Immediate_Echo
257 (Win : in Window := Standard_Window;
258 Ch : in Attributed_Character)
260 function Wechochar (W : Window;
261 Ch : C_Chtype) return C_Int;
262 pragma Import (C, Wechochar, "wechochar");
264 if Wechochar (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
265 raise Curses_Exception;
267 end Add_With_Immediate_Echo;
269 procedure Add_With_Immediate_Echo
270 (Win : in Window := Standard_Window;
274 Add_With_Immediate_Echo
276 Attributed_Character'(Ch => Ch,
277 Color => Color_Pair'First,
278 Attr => Normal_Video));
279 end Add_With_Immediate_Echo;
280 ------------------------------------------------------------------------------
281 function Create (Number_Of_Lines : Line_Count;
282 Number_Of_Columns : Column_Count;
283 First_Line_Position : Line_Position;
284 First_Column_Position : Column_Position) return Window
286 function Newwin (Number_Of_Lines : C_Int;
287 Number_Of_Columns : C_Int;
288 First_Line_Position : C_Int;
289 First_Column_Position : C_Int) return Window;
290 pragma Import (C, Newwin, "newwin");
294 W := Newwin (C_Int (Number_Of_Lines),
295 C_Int (Number_Of_Columns),
296 C_Int (First_Line_Position),
297 C_Int (First_Column_Position));
298 if W = Null_Window then
299 raise Curses_Exception;
304 procedure Delete (Win : in out Window)
306 function Wdelwin (W : Window) return C_Int;
307 pragma Import (C, Wdelwin, "delwin");
309 if Wdelwin (Win) = Curses_Err then
310 raise Curses_Exception;
316 (Win : Window := Standard_Window;
317 Number_Of_Lines : Line_Count;
318 Number_Of_Columns : Column_Count;
319 First_Line_Position : Line_Position;
320 First_Column_Position : Column_Position) return Window
324 Number_Of_Lines : C_Int;
325 Number_Of_Columns : C_Int;
326 First_Line_Position : C_Int;
327 First_Column_Position : C_Int) return Window;
328 pragma Import (C, Subwin, "subwin");
333 C_Int (Number_Of_Lines),
334 C_Int (Number_Of_Columns),
335 C_Int (First_Line_Position),
336 C_Int (First_Column_Position));
337 if W = Null_Window then
338 raise Curses_Exception;
343 function Derived_Window
344 (Win : Window := Standard_Window;
345 Number_Of_Lines : Line_Count;
346 Number_Of_Columns : Column_Count;
347 First_Line_Position : Line_Position;
348 First_Column_Position : Column_Position) return Window
352 Number_Of_Lines : C_Int;
353 Number_Of_Columns : C_Int;
354 First_Line_Position : C_Int;
355 First_Column_Position : C_Int) return Window;
356 pragma Import (C, Derwin, "derwin");
361 C_Int (Number_Of_Lines),
362 C_Int (Number_Of_Columns),
363 C_Int (First_Line_Position),
364 C_Int (First_Column_Position));
365 if W = Null_Window then
366 raise Curses_Exception;
371 function Duplicate (Win : Window) return Window
373 function Dupwin (Win : Window) return Window;
374 pragma Import (C, Dupwin, "dupwin");
376 W : Window := Dupwin (Win);
378 if W = Null_Window then
379 raise Curses_Exception;
384 procedure Move_Window (Win : in Window;
385 Line : in Line_Position;
386 Column : in Column_Position)
388 function Mvwin (Win : Window;
390 Column : C_Int) return C_Int;
391 pragma Import (C, Mvwin, "mvwin");
393 if Mvwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
394 raise Curses_Exception;
398 procedure Move_Derived_Window (Win : in Window;
399 Line : in Line_Position;
400 Column : in Column_Position)
402 function Mvderwin (Win : Window;
404 Column : C_Int) return C_Int;
405 pragma Import (C, Mvderwin, "mvderwin");
407 if Mvderwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
408 raise Curses_Exception;
410 end Move_Derived_Window;
412 procedure Set_Synch_Mode (Win : in Window := Standard_Window;
413 Mode : in Boolean := False)
415 function Syncok (Win : Window;
416 Mode : Curses_Bool) return C_Int;
417 pragma Import (C, Syncok, "syncok");
419 if Syncok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
420 raise Curses_Exception;
423 ------------------------------------------------------------------------------
424 procedure Add (Win : in Window := Standard_Window;
426 Len : in Integer := -1)
428 function Waddnstr (Win : Window;
430 Len : C_Int := -1) return C_Int;
431 pragma Import (C, Waddnstr, "waddnstr");
433 Txt : char_array (0 .. Str'Length);
436 To_C (Str, Txt, Length);
437 if Waddnstr (Win, Txt, C_Int (Len)) = Curses_Err then
438 raise Curses_Exception;
443 (Win : in Window := Standard_Window;
444 Line : in Line_Position;
445 Column : in Column_Position;
447 Len : in Integer := -1)
450 Move_Cursor (Win, Line, Column);
453 ------------------------------------------------------------------------------
455 (Win : in Window := Standard_Window;
456 Str : in Attributed_String;
457 Len : in Integer := -1)
459 function Waddchnstr (Win : Window;
461 Len : C_Int := -1) return C_Int;
462 pragma Import (C, Waddchnstr, "waddchnstr");
464 Txt : chtype_array (0 .. Str'Length);
466 for Length in 1 .. size_t (Str'Length) loop
467 Txt (Length - 1) := Str (Natural (Length));
469 Txt (Str'Length) := Default_Character;
472 C_Int (Len)) = Curses_Err then
473 raise Curses_Exception;
478 (Win : in Window := Standard_Window;
479 Line : in Line_Position;
480 Column : in Column_Position;
481 Str : in Attributed_String;
482 Len : in Integer := -1)
485 Move_Cursor (Win, Line, Column);
488 ------------------------------------------------------------------------------
490 (Win : in Window := Standard_Window;
491 Left_Side_Symbol : in Attributed_Character := Default_Character;
492 Right_Side_Symbol : in Attributed_Character := Default_Character;
493 Top_Side_Symbol : in Attributed_Character := Default_Character;
494 Bottom_Side_Symbol : in Attributed_Character := Default_Character;
495 Upper_Left_Corner_Symbol : in Attributed_Character := Default_Character;
496 Upper_Right_Corner_Symbol : in Attributed_Character := Default_Character;
497 Lower_Left_Corner_Symbol : in Attributed_Character := Default_Character;
498 Lower_Right_Corner_Symbol : in Attributed_Character := Default_Character)
500 function Wborder (W : Window;
508 LRC : C_Chtype) return C_Int;
509 pragma Import (C, Wborder, "wborder");
512 AttrChar_To_Chtype (Left_Side_Symbol),
513 AttrChar_To_Chtype (Right_Side_Symbol),
514 AttrChar_To_Chtype (Top_Side_Symbol),
515 AttrChar_To_Chtype (Bottom_Side_Symbol),
516 AttrChar_To_Chtype (Upper_Left_Corner_Symbol),
517 AttrChar_To_Chtype (Upper_Right_Corner_Symbol),
518 AttrChar_To_Chtype (Lower_Left_Corner_Symbol),
519 AttrChar_To_Chtype (Lower_Right_Corner_Symbol)
522 raise Curses_Exception;
527 (Win : in Window := Standard_Window;
528 Vertical_Symbol : in Attributed_Character := Default_Character;
529 Horizontal_Symbol : in Attributed_Character := Default_Character)
533 Vertical_Symbol, Vertical_Symbol,
534 Horizontal_Symbol, Horizontal_Symbol);
537 procedure Horizontal_Line
538 (Win : in Window := Standard_Window;
539 Line_Size : in Natural;
540 Line_Symbol : in Attributed_Character := Default_Character)
542 function Whline (W : Window;
544 Len : C_Int) return C_Int;
545 pragma Import (C, Whline, "whline");
548 AttrChar_To_Chtype (Line_Symbol),
549 C_Int (Line_Size)) = Curses_Err then
550 raise Curses_Exception;
554 procedure Vertical_Line
555 (Win : in Window := Standard_Window;
556 Line_Size : in Natural;
557 Line_Symbol : in Attributed_Character := Default_Character)
559 function Wvline (W : Window;
561 Len : C_Int) return C_Int;
562 pragma Import (C, Wvline, "wvline");
565 AttrChar_To_Chtype (Line_Symbol),
566 C_Int (Line_Size)) = Curses_Err then
567 raise Curses_Exception;
571 ------------------------------------------------------------------------------
572 function Get_Keystroke (Win : Window := Standard_Window)
575 function Wgetch (W : Window) return C_Int;
576 pragma Import (C, Wgetch, "wgetch");
578 C : constant C_Int := Wgetch (Win);
580 if C = Curses_Err then
583 return Real_Key_Code (C);
587 procedure Undo_Keystroke (Key : in Real_Key_Code)
589 function Ungetch (Ch : C_Int) return C_Int;
590 pragma Import (C, Ungetch, "ungetch");
592 if Ungetch (C_Int (Key)) = Curses_Err then
593 raise Curses_Exception;
597 function Has_Key (Key : Special_Key_Code) return Boolean
599 function Haskey (Key : C_Int) return C_Int;
600 pragma Import (C, Haskey, "has_key");
602 if Haskey (C_Int (Key)) = Curses_False then
609 function Is_Function_Key (Key : Special_Key_Code) return Boolean
611 L : constant Special_Key_Code := Special_Key_Code (Natural (Key_F0) +
612 Natural (Function_Key_Number'Last));
614 if (Key >= Key_F0) and then (Key <= L) then
621 function Function_Key (Key : Real_Key_Code)
622 return Function_Key_Number
625 if Is_Function_Key (Key) then
626 return Function_Key_Number (Key - Key_F0);
628 raise Constraint_Error;
632 function Function_Key_Code (Key : Function_Key_Number) return Real_Key_Code
635 return Real_Key_Code (Natural (Key_F0) + Natural (Key));
636 end Function_Key_Code;
637 ------------------------------------------------------------------------------
638 procedure Standout (Win : Window := Standard_Window;
639 On : Boolean := True)
641 function wstandout (Win : Window) return C_Int;
642 pragma Import (C, wstandout, "wstandout");
643 function wstandend (Win : Window) return C_Int;
644 pragma Import (C, wstandend, "wstandend");
649 Err := wstandout (Win);
651 Err := wstandend (Win);
653 if Err = Curses_Err then
654 raise Curses_Exception;
658 procedure Switch_Character_Attribute
659 (Win : in Window := Standard_Window;
660 Attr : in Character_Attribute_Set := Normal_Video;
661 On : in Boolean := True)
663 function Wattron (Win : Window;
664 C_Attr : C_AttrType) return C_Int;
665 pragma Import (C, Wattron, "wattr_on");
666 function Wattroff (Win : Window;
667 C_Attr : C_AttrType) return C_Int;
668 pragma Import (C, Wattroff, "wattr_off");
669 -- In Ada we use the On Boolean to control whether or not we want to
670 -- switch on or off the attributes in the set.
672 AC : constant Attributed_Character := (Ch => Character'First,
673 Color => Color_Pair'First,
677 Err := Wattron (Win, AttrChar_To_AttrType (AC));
679 Err := Wattroff (Win, AttrChar_To_AttrType (AC));
681 if Err = Curses_Err then
682 raise Curses_Exception;
684 end Switch_Character_Attribute;
686 procedure Set_Character_Attributes
687 (Win : in Window := Standard_Window;
688 Attr : in Character_Attribute_Set := Normal_Video;
689 Color : in Color_Pair := Color_Pair'First)
691 function Wattrset (Win : Window;
692 C_Attr : C_AttrType) return C_Int;
693 pragma Import (C, Wattrset, "wattrset"); -- ??? wattr_set
696 AttrChar_To_AttrType (Attributed_Character'
697 (Ch => Character'First,
699 Attr => Attr))) = Curses_Err then
700 raise Curses_Exception;
702 end Set_Character_Attributes;
704 function Get_Character_Attribute (Win : Window := Standard_Window)
705 return Character_Attribute_Set
707 function Wattrget (Win : Window;
708 Atr : access C_AttrType;
709 Col : access C_Short;
710 Opt : System.Address) return C_Int;
711 pragma Import (C, Wattrget, "wattr_get");
713 Attr : aliased C_AttrType;
714 Col : aliased C_Short;
715 Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
716 System.Null_Address);
717 Ch : Attributed_Character;
719 if Res = Curses_Ok then
720 Ch := AttrType_To_AttrChar (Attr);
723 raise Curses_Exception;
725 end Get_Character_Attribute;
727 function Get_Character_Attribute (Win : Window := Standard_Window)
730 function Wattrget (Win : Window;
731 Atr : access C_AttrType;
732 Col : access C_Short;
733 Opt : System.Address) return C_Int;
734 pragma Import (C, Wattrget, "wattr_get");
736 Attr : aliased C_AttrType;
737 Col : aliased C_Short;
738 Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
739 System.Null_Address);
740 Ch : Attributed_Character;
742 if Res = Curses_Ok then
743 Ch := AttrType_To_AttrChar (Attr);
746 raise Curses_Exception;
748 end Get_Character_Attribute;
750 procedure Set_Color (Win : in Window := Standard_Window;
751 Pair : in Color_Pair)
753 function Wset_Color (Win : Window;
755 Opts : C_Void_Ptr) return C_Int;
756 pragma Import (C, Wset_Color, "wcolor_set");
760 C_Void_Ptr (System.Null_Address)) = Curses_Err then
761 raise Curses_Exception;
765 procedure Change_Attributes
766 (Win : in Window := Standard_Window;
767 Count : in Integer := -1;
768 Attr : in Character_Attribute_Set := Normal_Video;
769 Color : in Color_Pair := Color_Pair'First)
771 function Wchgat (Win : Window;
775 Opts : System.Address := System.Null_Address)
777 pragma Import (C, Wchgat, "wchgat");
779 Ch : constant Attributed_Character :=
780 (Ch => Character'First, Color => Color_Pair'First, Attr => Attr);
782 if Wchgat (Win, C_Int (Count), AttrChar_To_AttrType (Ch),
783 C_Short (Color)) = Curses_Err then
784 raise Curses_Exception;
786 end Change_Attributes;
788 procedure Change_Attributes
789 (Win : in Window := Standard_Window;
790 Line : in Line_Position := Line_Position'First;
791 Column : in Column_Position := Column_Position'First;
792 Count : in Integer := -1;
793 Attr : in Character_Attribute_Set := Normal_Video;
794 Color : in Color_Pair := Color_Pair'First)
797 Move_Cursor (Win, Line, Column);
798 Change_Attributes (Win, Count, Attr, Color);
799 end Change_Attributes;
800 ------------------------------------------------------------------------------
803 function Beeper return C_Int;
804 pragma Import (C, Beeper, "beep");
806 if Beeper = Curses_Err then
807 raise Curses_Exception;
811 procedure Flash_Screen
813 function Flash return C_Int;
814 pragma Import (C, Flash, "flash");
816 if Flash = Curses_Err then
817 raise Curses_Exception;
820 ------------------------------------------------------------------------------
821 procedure Set_Cbreak_Mode (SwitchOn : in Boolean := True)
823 function Cbreak return C_Int;
824 pragma Import (C, Cbreak, "cbreak");
825 function NoCbreak return C_Int;
826 pragma Import (C, NoCbreak, "nocbreak");
835 if Err = Curses_Err then
836 raise Curses_Exception;
840 procedure Set_Raw_Mode (SwitchOn : in Boolean := True)
842 function Raw return C_Int;
843 pragma Import (C, Raw, "raw");
844 function NoRaw return C_Int;
845 pragma Import (C, NoRaw, "noraw");
854 if Err = Curses_Err then
855 raise Curses_Exception;
859 procedure Set_Echo_Mode (SwitchOn : in Boolean := True)
861 function Echo return C_Int;
862 pragma Import (C, Echo, "echo");
863 function NoEcho return C_Int;
864 pragma Import (C, NoEcho, "noecho");
873 if Err = Curses_Err then
874 raise Curses_Exception;
878 procedure Set_Meta_Mode (Win : in Window := Standard_Window;
879 SwitchOn : in Boolean := True)
881 function Meta (W : Window; Mode : Curses_Bool) return C_Int;
882 pragma Import (C, Meta, "meta");
884 if Meta (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then
885 raise Curses_Exception;
889 procedure Set_KeyPad_Mode (Win : in Window := Standard_Window;
890 SwitchOn : in Boolean := True)
892 function Keypad (W : Window; Mode : Curses_Bool) return C_Int;
893 pragma Import (C, Keypad, "keypad");
895 if Keypad (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then
896 raise Curses_Exception;
900 function Get_KeyPad_Mode (Win : in Window := Standard_Window)
904 return Get_Flag (Win, Offset_use_keypad);
907 procedure Half_Delay (Amount : in Half_Delay_Amount)
909 function Halfdelay (Amount : C_Int) return C_Int;
910 pragma Import (C, Halfdelay, "halfdelay");
912 if Halfdelay (C_Int (Amount)) = Curses_Err then
913 raise Curses_Exception;
917 procedure Set_Flush_On_Interrupt_Mode
918 (Win : in Window := Standard_Window;
919 Mode : in Boolean := True)
921 function Intrflush (Win : Window; Mode : Curses_Bool) return C_Int;
922 pragma Import (C, Intrflush, "intrflush");
924 if Intrflush (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
925 raise Curses_Exception;
927 end Set_Flush_On_Interrupt_Mode;
929 procedure Set_Queue_Interrupt_Mode
930 (Win : in Window := Standard_Window;
931 Flush : in Boolean := True)
934 pragma Import (C, Qiflush, "qiflush");
935 procedure No_Qiflush;
936 pragma Import (C, No_Qiflush, "noqiflush");
943 end Set_Queue_Interrupt_Mode;
945 procedure Set_NoDelay_Mode
946 (Win : in Window := Standard_Window;
947 Mode : in Boolean := False)
949 function Nodelay (Win : Window; Mode : Curses_Bool) return C_Int;
950 pragma Import (C, Nodelay, "nodelay");
952 if Nodelay (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
953 raise Curses_Exception;
955 end Set_NoDelay_Mode;
957 procedure Set_Timeout_Mode (Win : in Window := Standard_Window;
958 Mode : in Timeout_Mode;
961 function Wtimeout (Win : Window; Amount : C_Int) return C_Int;
962 pragma Import (C, Wtimeout, "wtimeout");
967 when Blocking => Time := -1;
968 when Non_Blocking => Time := 0;
971 raise Constraint_Error;
973 Time := C_Int (Amount);
975 if Wtimeout (Win, Time) = Curses_Err then
976 raise Curses_Exception;
978 end Set_Timeout_Mode;
980 procedure Set_Escape_Timer_Mode
981 (Win : in Window := Standard_Window;
982 Timer_Off : in Boolean := False)
984 function Notimeout (Win : Window; Mode : Curses_Bool) return C_Int;
985 pragma Import (C, Notimeout, "notimeout");
987 if Notimeout (Win, Curses_Bool (Boolean'Pos (Timer_Off)))
989 raise Curses_Exception;
991 end Set_Escape_Timer_Mode;
993 ------------------------------------------------------------------------------
994 procedure Set_NL_Mode (SwitchOn : in Boolean := True)
996 function NL return C_Int;
997 pragma Import (C, NL, "nl");
998 function NoNL return C_Int;
999 pragma Import (C, NoNL, "nonl");
1008 if Err = Curses_Err then
1009 raise Curses_Exception;
1013 procedure Clear_On_Next_Update
1014 (Win : in Window := Standard_Window;
1015 Do_Clear : in Boolean := True)
1017 function Clear_Ok (W : Window; Flag : Curses_Bool) return C_Int;
1018 pragma Import (C, Clear_Ok, "clearok");
1020 if Clear_Ok (Win, Curses_Bool (Boolean'Pos (Do_Clear))) = Curses_Err then
1021 raise Curses_Exception;
1023 end Clear_On_Next_Update;
1025 procedure Use_Insert_Delete_Line
1026 (Win : in Window := Standard_Window;
1027 Do_Idl : in Boolean := True)
1029 function IDL_Ok (W : Window; Flag : Curses_Bool) return C_Int;
1030 pragma Import (C, IDL_Ok, "idlok");
1032 if IDL_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idl))) = Curses_Err then
1033 raise Curses_Exception;
1035 end Use_Insert_Delete_Line;
1037 procedure Use_Insert_Delete_Character
1038 (Win : in Window := Standard_Window;
1039 Do_Idc : in Boolean := True)
1041 function IDC_Ok (W : Window; Flag : Curses_Bool) return C_Int;
1042 pragma Import (C, IDC_Ok, "idcok");
1044 if IDC_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idc))) = Curses_Err then
1045 raise Curses_Exception;
1047 end Use_Insert_Delete_Character;
1049 procedure Leave_Cursor_After_Update
1050 (Win : in Window := Standard_Window;
1051 Do_Leave : in Boolean := True)
1053 function Leave_Ok (W : Window; Flag : Curses_Bool) return C_Int;
1054 pragma Import (C, Leave_Ok, "leaveok");
1056 if Leave_Ok (Win, Curses_Bool (Boolean'Pos (Do_Leave))) = Curses_Err then
1057 raise Curses_Exception;
1059 end Leave_Cursor_After_Update;
1061 procedure Immediate_Update_Mode
1062 (Win : in Window := Standard_Window;
1063 Mode : in Boolean := False)
1065 function Immedok (Win : Window; Mode : Curses_Bool) return C_Int;
1066 pragma Import (C, Immedok, "immedok");
1068 if Immedok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
1069 raise Curses_Exception;
1071 end Immediate_Update_Mode;
1073 procedure Allow_Scrolling
1074 (Win : in Window := Standard_Window;
1075 Mode : in Boolean := False)
1077 function Scrollok (Win : Window; Mode : Curses_Bool) return C_Int;
1078 pragma Import (C, Scrollok, "scrollok");
1080 if Scrollok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
1081 raise Curses_Exception;
1083 end Allow_Scrolling;
1085 function Scrolling_Allowed (Win : Window := Standard_Window)
1089 return Get_Flag (Win, Offset_scroll);
1090 end Scrolling_Allowed;
1092 procedure Set_Scroll_Region
1093 (Win : in Window := Standard_Window;
1094 Top_Line : in Line_Position;
1095 Bottom_Line : in Line_Position)
1097 function Wsetscrreg (Win : Window;
1099 Col : C_Int) return C_Int;
1100 pragma Import (C, Wsetscrreg, "wsetscrreg");
1102 if Wsetscrreg (Win, C_Int (Top_Line), C_Int (Bottom_Line))
1104 raise Curses_Exception;
1106 end Set_Scroll_Region;
1107 ------------------------------------------------------------------------------
1108 procedure Update_Screen
1110 function Do_Update return C_Int;
1111 pragma Import (C, Do_Update, "doupdate");
1113 if Do_Update = Curses_Err then
1114 raise Curses_Exception;
1118 procedure Refresh (Win : in Window := Standard_Window)
1120 function Wrefresh (W : Window) return C_Int;
1121 pragma Import (C, Wrefresh, "wrefresh");
1123 if Wrefresh (Win) = Curses_Err then
1124 raise Curses_Exception;
1128 procedure Refresh_Without_Update
1129 (Win : in Window := Standard_Window)
1131 function Wnoutrefresh (W : Window) return C_Int;
1132 pragma Import (C, Wnoutrefresh, "wnoutrefresh");
1134 if Wnoutrefresh (Win) = Curses_Err then
1135 raise Curses_Exception;
1137 end Refresh_Without_Update;
1139 procedure Redraw (Win : in Window := Standard_Window)
1141 function Redrawwin (Win : Window) return C_Int;
1142 pragma Import (C, Redrawwin, "redrawwin");
1144 if Redrawwin (Win) = Curses_Err then
1145 raise Curses_Exception;
1150 (Win : in Window := Standard_Window;
1151 Begin_Line : in Line_Position;
1152 Line_Count : in Positive)
1154 function Wredrawln (Win : Window; First : C_Int; Cnt : C_Int)
1156 pragma Import (C, Wredrawln, "wredrawln");
1160 C_Int (Line_Count)) = Curses_Err then
1161 raise Curses_Exception;
1165 ------------------------------------------------------------------------------
1166 procedure Erase (Win : in Window := Standard_Window)
1168 function Werase (W : Window) return C_Int;
1169 pragma Import (C, Werase, "werase");
1171 if Werase (Win) = Curses_Err then
1172 raise Curses_Exception;
1176 procedure Clear (Win : in Window := Standard_Window)
1178 function Wclear (W : Window) return C_Int;
1179 pragma Import (C, Wclear, "wclear");
1181 if Wclear (Win) = Curses_Err then
1182 raise Curses_Exception;
1186 procedure Clear_To_End_Of_Screen (Win : in Window := Standard_Window)
1188 function Wclearbot (W : Window) return C_Int;
1189 pragma Import (C, Wclearbot, "wclrtobot");
1191 if Wclearbot (Win) = Curses_Err then
1192 raise Curses_Exception;
1194 end Clear_To_End_Of_Screen;
1196 procedure Clear_To_End_Of_Line (Win : in Window := Standard_Window)
1198 function Wcleareol (W : Window) return C_Int;
1199 pragma Import (C, Wcleareol, "wclrtoeol");
1201 if Wcleareol (Win) = Curses_Err then
1202 raise Curses_Exception;
1204 end Clear_To_End_Of_Line;
1205 ------------------------------------------------------------------------------
1206 procedure Set_Background
1207 (Win : in Window := Standard_Window;
1208 Ch : in Attributed_Character)
1210 procedure WBackground (W : in Window; Ch : in C_Chtype);
1211 pragma Import (C, WBackground, "wbkgdset");
1213 WBackground (Win, AttrChar_To_Chtype (Ch));
1216 procedure Change_Background
1217 (Win : in Window := Standard_Window;
1218 Ch : in Attributed_Character)
1220 function WChangeBkgd (W : Window; Ch : C_Chtype) return C_Int;
1221 pragma Import (C, WChangeBkgd, "wbkgd");
1223 if WChangeBkgd (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
1224 raise Curses_Exception;
1226 end Change_Background;
1228 function Get_Background (Win : Window := Standard_Window)
1229 return Attributed_Character
1231 function Wgetbkgd (Win : Window) return C_Chtype;
1232 pragma Import (C, Wgetbkgd, "getbkgd");
1234 return Chtype_To_AttrChar (Wgetbkgd (Win));
1236 ------------------------------------------------------------------------------
1237 procedure Change_Lines_Status (Win : in Window := Standard_Window;
1238 Start : in Line_Position;
1239 Count : in Positive;
1242 function Wtouchln (Win : Window;
1245 Chg : C_Int) return C_Int;
1246 pragma Import (C, Wtouchln, "wtouchln");
1248 if Wtouchln (Win, C_Int (Start), C_Int (Count),
1249 C_Int (Boolean'Pos (State))) = Curses_Err then
1250 raise Curses_Exception;
1252 end Change_Lines_Status;
1254 procedure Touch (Win : in Window := Standard_Window)
1257 X : Column_Position;
1259 Get_Size (Win, Y, X);
1260 Change_Lines_Status (Win, 0, Positive (Y), True);
1263 procedure Untouch (Win : in Window := Standard_Window)
1266 X : Column_Position;
1268 Get_Size (Win, Y, X);
1269 Change_Lines_Status (Win, 0, Positive (Y), False);
1272 procedure Touch (Win : in Window := Standard_Window;
1273 Start : in Line_Position;
1274 Count : in Positive)
1277 Change_Lines_Status (Win, Start, Count, True);
1281 (Win : Window := Standard_Window;
1282 Line : Line_Position) return Boolean
1284 function WLineTouched (W : Window; L : C_Int) return Curses_Bool;
1285 pragma Import (C, WLineTouched, "is_linetouched");
1287 if WLineTouched (Win, C_Int (Line)) = Curses_Bool_False then
1295 (Win : Window := Standard_Window) return Boolean
1297 function WWinTouched (W : Window) return Curses_Bool;
1298 pragma Import (C, WWinTouched, "is_wintouched");
1300 if WWinTouched (Win) = Curses_Bool_False then
1306 ------------------------------------------------------------------------------
1308 (Source_Window : in Window;
1309 Destination_Window : in Window;
1310 Source_Top_Row : in Line_Position;
1311 Source_Left_Column : in Column_Position;
1312 Destination_Top_Row : in Line_Position;
1313 Destination_Left_Column : in Column_Position;
1314 Destination_Bottom_Row : in Line_Position;
1315 Destination_Right_Column : in Column_Position;
1316 Non_Destructive_Mode : in Boolean := True)
1318 function Copywin (Src : Window;
1326 Ndm : C_Int) return C_Int;
1327 pragma Import (C, Copywin, "copywin");
1329 if Copywin (Source_Window,
1331 C_Int (Source_Top_Row),
1332 C_Int (Source_Left_Column),
1333 C_Int (Destination_Top_Row),
1334 C_Int (Destination_Left_Column),
1335 C_Int (Destination_Bottom_Row),
1336 C_Int (Destination_Right_Column),
1337 Boolean'Pos (Non_Destructive_Mode)
1339 raise Curses_Exception;
1344 (Source_Window : in Window;
1345 Destination_Window : in Window)
1347 function Overwrite (Src : Window; Dst : Window) return C_Int;
1348 pragma Import (C, Overwrite, "overwrite");
1350 if Overwrite (Source_Window, Destination_Window) = Curses_Err then
1351 raise Curses_Exception;
1356 (Source_Window : in Window;
1357 Destination_Window : in Window)
1359 function Overlay (Src : Window; Dst : Window) return C_Int;
1360 pragma Import (C, Overlay, "overlay");
1362 if Overlay (Source_Window, Destination_Window) = Curses_Err then
1363 raise Curses_Exception;
1367 ------------------------------------------------------------------------------
1368 procedure Insert_Delete_Lines
1369 (Win : in Window := Standard_Window;
1370 Lines : in Integer := 1) -- default is to insert one line above
1372 function Winsdelln (W : Window; N : C_Int) return C_Int;
1373 pragma Import (C, Winsdelln, "winsdelln");
1375 if Winsdelln (Win, C_Int (Lines)) = Curses_Err then
1376 raise Curses_Exception;
1378 end Insert_Delete_Lines;
1380 procedure Delete_Line (Win : in Window := Standard_Window)
1383 Insert_Delete_Lines (Win, -1);
1386 procedure Insert_Line (Win : in Window := Standard_Window)
1389 Insert_Delete_Lines (Win, 1);
1391 ------------------------------------------------------------------------------
1395 (Win : in Window := Standard_Window;
1396 Number_Of_Lines : out Line_Count;
1397 Number_Of_Columns : out Column_Count)
1399 -- Please note: in ncurses they are one off.
1400 -- This might be different in other implementations of curses
1401 Y : C_Int := C_Int (W_Get_Short (Win, Offset_maxy)) + C_Int (Offset_XY);
1402 X : C_Int := C_Int (W_Get_Short (Win, Offset_maxx)) + C_Int (Offset_XY);
1404 Number_Of_Lines := Line_Count (Y);
1405 Number_Of_Columns := Column_Count (X);
1408 procedure Get_Window_Position
1409 (Win : in Window := Standard_Window;
1410 Top_Left_Line : out Line_Position;
1411 Top_Left_Column : out Column_Position)
1413 Y : C_Short := W_Get_Short (Win, Offset_begy);
1414 X : C_Short := W_Get_Short (Win, Offset_begx);
1416 Top_Left_Line := Line_Position (Y);
1417 Top_Left_Column := Column_Position (X);
1418 end Get_Window_Position;
1420 procedure Get_Cursor_Position
1421 (Win : in Window := Standard_Window;
1422 Line : out Line_Position;
1423 Column : out Column_Position)
1425 Y : C_Short := W_Get_Short (Win, Offset_cury);
1426 X : C_Short := W_Get_Short (Win, Offset_curx);
1428 Line := Line_Position (Y);
1429 Column := Column_Position (X);
1430 end Get_Cursor_Position;
1432 procedure Get_Origin_Relative_To_Parent
1434 Top_Left_Line : out Line_Position;
1435 Top_Left_Column : out Column_Position;
1436 Is_Not_A_Subwindow : out Boolean)
1438 Y : C_Int := W_Get_Int (Win, Offset_pary);
1439 X : C_Int := W_Get_Int (Win, Offset_parx);
1442 Top_Left_Line := Line_Position'Last;
1443 Top_Left_Column := Column_Position'Last;
1444 Is_Not_A_Subwindow := True;
1446 Top_Left_Line := Line_Position (Y);
1447 Top_Left_Column := Column_Position (X);
1448 Is_Not_A_Subwindow := False;
1450 end Get_Origin_Relative_To_Parent;
1451 ------------------------------------------------------------------------------
1452 function New_Pad (Lines : Line_Count;
1453 Columns : Column_Count) return Window
1455 function Newpad (Lines : C_Int; Columns : C_Int) return Window;
1456 pragma Import (C, Newpad, "newpad");
1460 W := Newpad (C_Int (Lines), C_Int (Columns));
1461 if W = Null_Window then
1462 raise Curses_Exception;
1469 Number_Of_Lines : Line_Count;
1470 Number_Of_Columns : Column_Count;
1471 First_Line_Position : Line_Position;
1472 First_Column_Position : Column_Position) return Window
1476 Number_Of_Lines : C_Int;
1477 Number_Of_Columns : C_Int;
1478 First_Line_Position : C_Int;
1479 First_Column_Position : C_Int) return Window;
1480 pragma Import (C, Subpad, "subpad");
1485 C_Int (Number_Of_Lines),
1486 C_Int (Number_Of_Columns),
1487 C_Int (First_Line_Position),
1488 C_Int (First_Column_Position));
1489 if W = Null_Window then
1490 raise Curses_Exception;
1497 Source_Top_Row : in Line_Position;
1498 Source_Left_Column : in Column_Position;
1499 Destination_Top_Row : in Line_Position;
1500 Destination_Left_Column : in Column_Position;
1501 Destination_Bottom_Row : in Line_Position;
1502 Destination_Right_Column : in Column_Position)
1506 Source_Top_Row : C_Int;
1507 Source_Left_Column : C_Int;
1508 Destination_Top_Row : C_Int;
1509 Destination_Left_Column : C_Int;
1510 Destination_Bottom_Row : C_Int;
1511 Destination_Right_Column : C_Int) return C_Int;
1512 pragma Import (C, Prefresh, "prefresh");
1515 C_Int (Source_Top_Row),
1516 C_Int (Source_Left_Column),
1517 C_Int (Destination_Top_Row),
1518 C_Int (Destination_Left_Column),
1519 C_Int (Destination_Bottom_Row),
1520 C_Int (Destination_Right_Column)) = Curses_Err then
1521 raise Curses_Exception;
1525 procedure Refresh_Without_Update
1527 Source_Top_Row : in Line_Position;
1528 Source_Left_Column : in Column_Position;
1529 Destination_Top_Row : in Line_Position;
1530 Destination_Left_Column : in Column_Position;
1531 Destination_Bottom_Row : in Line_Position;
1532 Destination_Right_Column : in Column_Position)
1534 function Pnoutrefresh
1536 Source_Top_Row : C_Int;
1537 Source_Left_Column : C_Int;
1538 Destination_Top_Row : C_Int;
1539 Destination_Left_Column : C_Int;
1540 Destination_Bottom_Row : C_Int;
1541 Destination_Right_Column : C_Int) return C_Int;
1542 pragma Import (C, Pnoutrefresh, "pnoutrefresh");
1544 if Pnoutrefresh (Pad,
1545 C_Int (Source_Top_Row),
1546 C_Int (Source_Left_Column),
1547 C_Int (Destination_Top_Row),
1548 C_Int (Destination_Left_Column),
1549 C_Int (Destination_Bottom_Row),
1550 C_Int (Destination_Right_Column)) = Curses_Err then
1551 raise Curses_Exception;
1553 end Refresh_Without_Update;
1555 procedure Add_Character_To_Pad_And_Echo_It
1557 Ch : in Attributed_Character)
1559 function Pechochar (Pad : Window; Ch : C_Chtype)
1561 pragma Import (C, Pechochar, "pechochar");
1563 if Pechochar (Pad, AttrChar_To_Chtype (Ch)) = Curses_Err then
1564 raise Curses_Exception;
1566 end Add_Character_To_Pad_And_Echo_It;
1568 procedure Add_Character_To_Pad_And_Echo_It
1573 Add_Character_To_Pad_And_Echo_It
1575 Attributed_Character'(Ch => Ch,
1576 Color => Color_Pair'First,
1577 Attr => Normal_Video));
1578 end Add_Character_To_Pad_And_Echo_It;
1579 ------------------------------------------------------------------------------
1580 procedure Scroll (Win : in Window := Standard_Window;
1581 Amount : in Integer := 1)
1583 function Wscrl (Win : Window; N : C_Int) return C_Int;
1584 pragma Import (C, Wscrl, "wscrl");
1587 if Wscrl (Win, C_Int (Amount)) = Curses_Err then
1588 raise Curses_Exception;
1592 ------------------------------------------------------------------------------
1593 procedure Delete_Character (Win : in Window := Standard_Window)
1595 function Wdelch (Win : Window) return C_Int;
1596 pragma Import (C, Wdelch, "wdelch");
1598 if Wdelch (Win) = Curses_Err then
1599 raise Curses_Exception;
1601 end Delete_Character;
1603 procedure Delete_Character
1604 (Win : in Window := Standard_Window;
1605 Line : in Line_Position;
1606 Column : in Column_Position)
1608 function Mvwdelch (Win : Window;
1610 Col : C_Int) return C_Int;
1611 pragma Import (C, Mvwdelch, "mvwdelch");
1613 if Mvwdelch (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
1614 raise Curses_Exception;
1616 end Delete_Character;
1617 ------------------------------------------------------------------------------
1618 function Peek (Win : Window := Standard_Window)
1619 return Attributed_Character
1621 function Winch (Win : Window) return C_Chtype;
1622 pragma Import (C, Winch, "winch");
1624 return Chtype_To_AttrChar (Winch (Win));
1628 (Win : Window := Standard_Window;
1629 Line : Line_Position;
1630 Column : Column_Position) return Attributed_Character
1632 function Mvwinch (Win : Window;
1634 Col : C_Int) return C_Chtype;
1635 pragma Import (C, Mvwinch, "mvwinch");
1637 return Chtype_To_AttrChar (Mvwinch (Win, C_Int (Line), C_Int (Column)));
1639 ------------------------------------------------------------------------------
1640 procedure Insert (Win : in Window := Standard_Window;
1641 Ch : in Attributed_Character)
1643 function Winsch (Win : Window; Ch : C_Chtype) return C_Int;
1644 pragma Import (C, Winsch, "winsch");
1646 if Winsch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
1647 raise Curses_Exception;
1652 (Win : in Window := Standard_Window;
1653 Line : in Line_Position;
1654 Column : in Column_Position;
1655 Ch : in Attributed_Character)
1657 function Mvwinsch (Win : Window;
1660 Ch : C_Chtype) return C_Int;
1661 pragma Import (C, Mvwinsch, "mvwinsch");
1666 AttrChar_To_Chtype (Ch)) = Curses_Err then
1667 raise Curses_Exception;
1670 ------------------------------------------------------------------------------
1671 procedure Insert (Win : in Window := Standard_Window;
1673 Len : in Integer := -1)
1675 function Winsnstr (Win : Window;
1677 Len : Integer := -1) return C_Int;
1678 pragma Import (C, Winsnstr, "winsnstr");
1680 Txt : char_array (0 .. Str'Length);
1683 To_C (Str, Txt, Length);
1684 if Winsnstr (Win, Txt, Len) = Curses_Err then
1685 raise Curses_Exception;
1690 (Win : in Window := Standard_Window;
1691 Line : in Line_Position;
1692 Column : in Column_Position;
1694 Len : in Integer := -1)
1696 function Mvwinsnstr (Win : Window;
1700 Len : C_Int) return C_Int;
1701 pragma Import (C, Mvwinsnstr, "mvwinsnstr");
1703 Txt : char_array (0 .. Str'Length);
1706 To_C (Str, Txt, Length);
1707 if Mvwinsnstr (Win, C_Int (Line), C_Int (Column), Txt, C_Int (Len))
1709 raise Curses_Exception;
1712 ------------------------------------------------------------------------------
1713 procedure Peek (Win : in Window := Standard_Window;
1715 Len : in Integer := -1)
1717 function Winnstr (Win : Window;
1719 Len : C_Int) return C_Int;
1720 pragma Import (C, Winnstr, "winnstr");
1723 Txt : char_array (0 .. Str'Length);
1729 if N > Str'Length then
1730 raise Constraint_Error;
1732 Txt (0) := Interfaces.C.char'First;
1733 if Winnstr (Win, Txt, C_Int (N)) = Curses_Err then
1734 raise Curses_Exception;
1736 To_Ada (Txt, Str, Cnt, True);
1737 if Cnt < Str'Length then
1738 Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
1743 (Win : in Window := Standard_Window;
1744 Line : in Line_Position;
1745 Column : in Column_Position;
1747 Len : in Integer := -1)
1750 Move_Cursor (Win, Line, Column);
1751 Peek (Win, Str, Len);
1753 ------------------------------------------------------------------------------
1755 (Win : in Window := Standard_Window;
1756 Str : out Attributed_String;
1757 Len : in Integer := -1)
1759 function Winchnstr (Win : Window;
1760 Str : chtype_array; -- out
1761 Len : C_Int) return C_Int;
1762 pragma Import (C, Winchnstr, "winchnstr");
1765 Txt : chtype_array (0 .. Str'Length) := (0 => Default_Character);
1771 if N > Str'Length then
1772 raise Constraint_Error;
1774 if Winchnstr (Win, Txt, C_Int (N)) = Curses_Err then
1775 raise Curses_Exception;
1777 for To in Str'Range loop
1778 exit when Txt (size_t (Cnt)) = Default_Character;
1779 Str (To) := Txt (size_t (Cnt));
1782 if Cnt < Str'Length then
1783 Str ((Str'First + Cnt) .. Str'Last) :=
1784 (others => (Ch => ' ',
1785 Color => Color_Pair'First,
1786 Attr => Normal_Video));
1791 (Win : in Window := Standard_Window;
1792 Line : in Line_Position;
1793 Column : in Column_Position;
1794 Str : out Attributed_String;
1795 Len : in Integer := -1)
1798 Move_Cursor (Win, Line, Column);
1799 Peek (Win, Str, Len);
1801 ------------------------------------------------------------------------------
1802 procedure Get (Win : in Window := Standard_Window;
1804 Len : in Integer := -1)
1806 function Wgetnstr (Win : Window;
1808 Len : C_Int) return C_Int;
1809 pragma Import (C, Wgetnstr, "wgetnstr");
1812 Txt : char_array (0 .. Str'Length);
1818 if N > Str'Length then
1819 raise Constraint_Error;
1821 Txt (0) := Interfaces.C.char'First;
1822 if Wgetnstr (Win, Txt, C_Int (N)) = Curses_Err then
1823 raise Curses_Exception;
1825 To_Ada (Txt, Str, Cnt, True);
1826 if Cnt < Str'Length then
1827 Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
1832 (Win : in Window := Standard_Window;
1833 Line : in Line_Position;
1834 Column : in Column_Position;
1836 Len : in Integer := -1)
1839 Move_Cursor (Win, Line, Column);
1840 Get (Win, Str, Len);
1842 ------------------------------------------------------------------------------
1843 procedure Init_Soft_Label_Keys
1844 (Format : in Soft_Label_Key_Format := Three_Two_Three)
1846 function Slk_Init (Fmt : C_Int) return C_Int;
1847 pragma Import (C, Slk_Init, "slk_init");
1849 if Slk_Init (Soft_Label_Key_Format'Pos (Format)) = Curses_Err then
1850 raise Curses_Exception;
1852 end Init_Soft_Label_Keys;
1854 procedure Set_Soft_Label_Key (Label : in Label_Number;
1856 Fmt : in Label_Justification := Left)
1858 function Slk_Set (Label : C_Int;
1860 Fmt : C_Int) return C_Int;
1861 pragma Import (C, Slk_Set, "slk_set");
1863 Txt : char_array (0 .. Text'Length);
1866 To_C (Text, Txt, Len);
1867 if Slk_Set (C_Int (Label), Txt,
1868 C_Int (Label_Justification'Pos (Fmt))) = Curses_Err then
1869 raise Curses_Exception;
1871 end Set_Soft_Label_Key;
1873 procedure Refresh_Soft_Label_Keys
1875 function Slk_Refresh return C_Int;
1876 pragma Import (C, Slk_Refresh, "slk_refresh");
1878 if Slk_Refresh = Curses_Err then
1879 raise Curses_Exception;
1881 end Refresh_Soft_Label_Keys;
1883 procedure Refresh_Soft_Label_Keys_Without_Update
1885 function Slk_Noutrefresh return C_Int;
1886 pragma Import (C, Slk_Noutrefresh, "slk_noutrefresh");
1888 if Slk_Noutrefresh = Curses_Err then
1889 raise Curses_Exception;
1891 end Refresh_Soft_Label_Keys_Without_Update;
1893 procedure Get_Soft_Label_Key (Label : in Label_Number;
1896 function Slk_Label (Label : C_Int) return chars_ptr;
1897 pragma Import (C, Slk_Label, "slk_label");
1899 Fill_String (Slk_Label (C_Int (Label)), Text);
1900 end Get_Soft_Label_Key;
1902 function Get_Soft_Label_Key (Label : in Label_Number) return String
1904 function Slk_Label (Label : C_Int) return chars_ptr;
1905 pragma Import (C, Slk_Label, "slk_label");
1907 return Fill_String (Slk_Label (C_Int (Label)));
1908 end Get_Soft_Label_Key;
1910 procedure Clear_Soft_Label_Keys
1912 function Slk_Clear return C_Int;
1913 pragma Import (C, Slk_Clear, "slk_clear");
1915 if Slk_Clear = Curses_Err then
1916 raise Curses_Exception;
1918 end Clear_Soft_Label_Keys;
1920 procedure Restore_Soft_Label_Keys
1922 function Slk_Restore return C_Int;
1923 pragma Import (C, Slk_Restore, "slk_restore");
1925 if Slk_Restore = Curses_Err then
1926 raise Curses_Exception;
1928 end Restore_Soft_Label_Keys;
1930 procedure Touch_Soft_Label_Keys
1932 function Slk_Touch return C_Int;
1933 pragma Import (C, Slk_Touch, "slk_touch");
1935 if Slk_Touch = Curses_Err then
1936 raise Curses_Exception;
1938 end Touch_Soft_Label_Keys;
1940 procedure Switch_Soft_Label_Key_Attributes
1941 (Attr : in Character_Attribute_Set;
1942 On : in Boolean := True)
1944 function Slk_Attron (Ch : C_Chtype) return C_Int;
1945 pragma Import (C, Slk_Attron, "slk_attron");
1946 function Slk_Attroff (Ch : C_Chtype) return C_Int;
1947 pragma Import (C, Slk_Attroff, "slk_attroff");
1950 Ch : constant Attributed_Character := (Ch => Character'First,
1952 Color => Color_Pair'First);
1955 Err := Slk_Attron (AttrChar_To_Chtype (Ch));
1957 Err := Slk_Attroff (AttrChar_To_Chtype (Ch));
1959 if Err = Curses_Err then
1960 raise Curses_Exception;
1962 end Switch_Soft_Label_Key_Attributes;
1964 procedure Set_Soft_Label_Key_Attributes
1965 (Attr : in Character_Attribute_Set := Normal_Video;
1966 Color : in Color_Pair := Color_Pair'First)
1968 function Slk_Attrset (Ch : C_Chtype) return C_Int;
1969 pragma Import (C, Slk_Attrset, "slk_attrset");
1971 Ch : constant Attributed_Character := (Ch => Character'First,
1975 if Slk_Attrset (AttrChar_To_Chtype (Ch)) = Curses_Err then
1976 raise Curses_Exception;
1978 end Set_Soft_Label_Key_Attributes;
1980 function Get_Soft_Label_Key_Attributes return Character_Attribute_Set
1982 function Slk_Attr return C_Chtype;
1983 pragma Import (C, Slk_Attr, "slk_attr");
1985 Attr : constant C_Chtype := Slk_Attr;
1987 return Chtype_To_AttrChar (Attr).Attr;
1988 end Get_Soft_Label_Key_Attributes;
1990 function Get_Soft_Label_Key_Attributes return Color_Pair
1992 function Slk_Attr return C_Chtype;
1993 pragma Import (C, Slk_Attr, "slk_attr");
1995 Attr : constant C_Chtype := Slk_Attr;
1997 return Chtype_To_AttrChar (Attr).Color;
1998 end Get_Soft_Label_Key_Attributes;
2000 procedure Set_Soft_Label_Key_Color (Pair : in Color_Pair)
2002 function Slk_Color (Color : in C_Short) return C_Int;
2003 pragma Import (C, Slk_Color, "slk_color");
2005 if Slk_Color (C_Short (Pair)) = Curses_Err then
2006 raise Curses_Exception;
2008 end Set_Soft_Label_Key_Color;
2010 ------------------------------------------------------------------------------
2011 procedure Enable_Key (Key : in Special_Key_Code;
2012 Enable : in Boolean := True)
2014 function Keyok (Keycode : C_Int;
2015 On_Off : Curses_Bool) return C_Int;
2016 pragma Import (C, Keyok, "keyok");
2018 if Keyok (C_Int (Key), Curses_Bool (Boolean'Pos (Enable)))
2020 raise Curses_Exception;
2023 ------------------------------------------------------------------------------
2024 procedure Define_Key (Definition : in String;
2025 Key : in Special_Key_Code)
2027 function Defkey (Def : char_array;
2028 Key : C_Int) return C_Int;
2029 pragma Import (C, Defkey, "define_key");
2031 Txt : char_array (0 .. Definition'Length);
2034 To_C (Definition, Txt, Length);
2035 if Defkey (Txt, C_Int (Key)) = Curses_Err then
2036 raise Curses_Exception;
2039 ------------------------------------------------------------------------------
2040 procedure Un_Control (Ch : in Attributed_Character;
2043 function Unctrl (Ch : C_Chtype) return chars_ptr;
2044 pragma Import (C, Unctrl, "unctrl");
2046 Fill_String (Unctrl (AttrChar_To_Chtype (Ch)), Str);
2049 function Un_Control (Ch : in Attributed_Character) return String
2051 function Unctrl (Ch : C_Chtype) return chars_ptr;
2052 pragma Import (C, Unctrl, "unctrl");
2054 return Fill_String (Unctrl (AttrChar_To_Chtype (Ch)));
2057 procedure Delay_Output (Msecs : in Natural)
2059 function Delayoutput (Msecs : C_Int) return C_Int;
2060 pragma Import (C, Delayoutput, "delay_output");
2062 if Delayoutput (C_Int (Msecs)) = Curses_Err then
2063 raise Curses_Exception;
2067 procedure Flush_Input
2069 function Flushinp return C_Int;
2070 pragma Import (C, Flushinp, "flushinp");
2072 if Flushinp = Curses_Err then -- docu says that never happens, but...
2073 raise Curses_Exception;
2076 ------------------------------------------------------------------------------
2077 function Baudrate return Natural
2079 function Baud return C_Int;
2080 pragma Import (C, Baud, "baudrate");
2082 return Natural (Baud);
2085 function Erase_Character return Character
2087 function Erasechar return C_Int;
2088 pragma Import (C, Erasechar, "erasechar");
2090 return Character'Val (Erasechar);
2091 end Erase_Character;
2093 function Kill_Character return Character
2095 function Killchar return C_Int;
2096 pragma Import (C, Killchar, "killchar");
2098 return Character'Val (Killchar);
2101 function Has_Insert_Character return Boolean
2103 function Has_Ic return Curses_Bool;
2104 pragma Import (C, Has_Ic, "has_ic");
2106 if Has_Ic = Curses_Bool_False then
2111 end Has_Insert_Character;
2113 function Has_Insert_Line return Boolean
2115 function Has_Il return Curses_Bool;
2116 pragma Import (C, Has_Il, "has_il");
2118 if Has_Il = Curses_Bool_False then
2123 end Has_Insert_Line;
2125 function Supported_Attributes return Character_Attribute_Set
2127 function Termattrs return C_Chtype;
2128 pragma Import (C, Termattrs, "termattrs");
2130 Ch : constant Attributed_Character := Chtype_To_AttrChar (Termattrs);
2133 end Supported_Attributes;
2135 procedure Long_Name (Name : out String)
2137 function Longname return chars_ptr;
2138 pragma Import (C, Longname, "longname");
2140 Fill_String (Longname, Name);
2143 function Long_Name return String
2145 function Longname return chars_ptr;
2146 pragma Import (C, Longname, "longname");
2148 return Fill_String (Longname);
2151 procedure Terminal_Name (Name : out String)
2153 function Termname return chars_ptr;
2154 pragma Import (C, Termname, "termname");
2156 Fill_String (Termname, Name);
2159 function Terminal_Name return String
2161 function Termname return chars_ptr;
2162 pragma Import (C, Termname, "termname");
2164 return Fill_String (Termname);
2166 ------------------------------------------------------------------------------
2167 procedure Init_Pair (Pair : in Redefinable_Color_Pair;
2168 Fore : in Color_Number;
2169 Back : in Color_Number)
2171 function Initpair (Pair : C_Short;
2173 Back : C_Short) return C_Int;
2174 pragma Import (C, Initpair, "init_pair");
2176 if Integer (Pair) >= Number_Of_Color_Pairs then
2177 raise Constraint_Error;
2179 if Integer (Fore) >= Number_Of_Colors or else
2180 Integer (Back) >= Number_Of_Colors then raise Constraint_Error;
2182 if Initpair (C_Short (Pair), C_Short (Fore), C_Short (Back))
2184 raise Curses_Exception;
2188 procedure Pair_Content (Pair : in Color_Pair;
2189 Fore : out Color_Number;
2190 Back : out Color_Number)
2192 type C_Short_Access is access all C_Short;
2193 function Paircontent (Pair : C_Short;
2194 Fp : C_Short_Access;
2195 Bp : C_Short_Access) return C_Int;
2196 pragma Import (C, Paircontent, "pair_content");
2198 F, B : aliased C_Short;
2200 if Paircontent (C_Short (Pair), F'Access, B'Access) = Curses_Err then
2201 raise Curses_Exception;
2203 Fore := Color_Number (F);
2204 Back := Color_Number (B);
2208 function Has_Colors return Boolean
2210 function Hascolors return Curses_Bool;
2211 pragma Import (C, Hascolors, "has_colors");
2213 if Hascolors = Curses_Bool_False then
2220 procedure Init_Color (Color : in Color_Number;
2222 Green : in RGB_Value;
2223 Blue : in RGB_Value)
2225 function Initcolor (Col : C_Short;
2228 Blue : C_Short) return C_Int;
2229 pragma Import (C, Initcolor, "init_color");
2231 if Initcolor (C_Short (Color), C_Short (Red), C_Short (Green),
2232 C_Short (Blue)) = Curses_Err then
2233 raise Curses_Exception;
2237 function Can_Change_Color return Boolean
2239 function Canchangecolor return Curses_Bool;
2240 pragma Import (C, Canchangecolor, "can_change_color");
2242 if Canchangecolor = Curses_Bool_False then
2247 end Can_Change_Color;
2249 procedure Color_Content (Color : in Color_Number;
2250 Red : out RGB_Value;
2251 Green : out RGB_Value;
2252 Blue : out RGB_Value)
2254 type C_Short_Access is access all C_Short;
2256 function Colorcontent (Color : C_Short; R, G, B : C_Short_Access)
2258 pragma Import (C, Colorcontent, "color_content");
2260 R, G, B : aliased C_Short;
2262 if Colorcontent (C_Short (Color), R'Access, G'Access, B'Access) =
2264 raise Curses_Exception;
2266 Red := RGB_Value (R);
2267 Green := RGB_Value (G);
2268 Blue := RGB_Value (B);
2272 ------------------------------------------------------------------------------
2273 procedure Save_Curses_Mode (Mode : in Curses_Mode)
2275 function Def_Prog_Mode return C_Int;
2276 pragma Import (C, Def_Prog_Mode, "def_prog_mode");
2277 function Def_Shell_Mode return C_Int;
2278 pragma Import (C, Def_Shell_Mode, "def_shell_mode");
2283 when Curses => Err := Def_Prog_Mode;
2284 when Shell => Err := Def_Shell_Mode;
2286 if Err = Curses_Err then
2287 raise Curses_Exception;
2289 end Save_Curses_Mode;
2291 procedure Reset_Curses_Mode (Mode : in Curses_Mode)
2293 function Reset_Prog_Mode return C_Int;
2294 pragma Import (C, Reset_Prog_Mode, "reset_prog_mode");
2295 function Reset_Shell_Mode return C_Int;
2296 pragma Import (C, Reset_Shell_Mode, "reset_shell_mode");
2301 when Curses => Err := Reset_Prog_Mode;
2302 when Shell => Err := Reset_Shell_Mode;
2304 if Err = Curses_Err then
2305 raise Curses_Exception;
2307 end Reset_Curses_Mode;
2309 procedure Save_Terminal_State
2311 function Savetty return C_Int;
2312 pragma Import (C, Savetty, "savetty");
2314 if Savetty = Curses_Err then
2315 raise Curses_Exception;
2317 end Save_Terminal_State;
2319 procedure Reset_Terminal_State
2321 function Resetty return C_Int;
2322 pragma Import (C, Resetty, "resetty");
2324 if Resetty = Curses_Err then
2325 raise Curses_Exception;
2327 end Reset_Terminal_State;
2329 procedure Rip_Off_Lines (Lines : in Integer;
2330 Proc : in Stdscr_Init_Proc)
2332 function Ripoffline (Lines : C_Int;
2333 Proc : Stdscr_Init_Proc) return C_Int;
2334 pragma Import (C, Ripoffline, "_nc_ripoffline");
2336 if Ripoffline (C_Int (Lines), Proc) = Curses_Err then
2337 raise Curses_Exception;
2341 procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility)
2343 function Curs_Set (Curs : C_Int) return C_Int;
2344 pragma Import (C, Curs_Set, "curs_set");
2348 Res := Curs_Set (Cursor_Visibility'Pos (Visibility));
2349 if Res /= Curses_Err then
2350 Visibility := Cursor_Visibility'Val (Res);
2352 end Set_Cursor_Visibility;
2354 procedure Nap_Milli_Seconds (Ms : in Natural)
2356 function Napms (Ms : C_Int) return C_Int;
2357 pragma Import (C, Napms, "napms");
2359 if Napms (C_Int (Ms)) = Curses_Err then
2360 raise Curses_Exception;
2362 end Nap_Milli_Seconds;
2363 ------------------------------------------------------------------------------
2365 function Standard_Window return Window
2368 pragma Import (C, Stdscr, "stdscr");
2371 end Standard_Window;
2373 function Lines return Line_Count
2376 pragma Import (C, C_Lines, "LINES");
2378 return Line_Count (C_Lines);
2381 function Columns return Column_Count
2384 pragma Import (C, C_Columns, "COLS");
2386 return Column_Count (C_Columns);
2389 function Tab_Size return Natural
2392 pragma Import (C, C_Tab_Size, "TABSIZE");
2394 return Natural (C_Tab_Size);
2397 function Number_Of_Colors return Natural
2399 C_Number_Of_Colors : C_Int;
2400 pragma Import (C, C_Number_Of_Colors, "COLORS");
2402 return Natural (C_Number_Of_Colors);
2403 end Number_Of_Colors;
2405 function Number_Of_Color_Pairs return Natural
2407 C_Number_Of_Color_Pairs : C_Int;
2408 pragma Import (C, C_Number_Of_Color_Pairs, "COLOR_PAIRS");
2410 return Natural (C_Number_Of_Color_Pairs);
2411 end Number_Of_Color_Pairs;
2412 ------------------------------------------------------------------------------
2413 procedure Transform_Coordinates
2414 (W : in Window := Standard_Window;
2415 Line : in out Line_Position;
2416 Column : in out Column_Position;
2417 Dir : in Transform_Direction := From_Screen)
2419 type Int_Access is access all C_Int;
2420 function Transform (W : Window;
2422 Dir : Curses_Bool) return C_Int;
2423 pragma Import (C, Transform, "wmouse_trafo");
2425 X : aliased C_Int := C_Int (Column);
2426 Y : aliased C_Int := C_Int (Line);
2427 D : Curses_Bool := Curses_Bool_False;
2430 if Dir = To_Screen then
2433 R := Transform (W, Y'Access, X'Access, D);
2434 if R = Curses_False then
2435 raise Curses_Exception;
2437 Line := Line_Position (Y);
2438 Column := Column_Position (X);
2440 end Transform_Coordinates;
2441 ------------------------------------------------------------------------------
2442 procedure Use_Default_Colors is
2443 function C_Use_Default_Colors return C_Int;
2444 pragma Import (C, C_Use_Default_Colors, "use_default_colors");
2445 Err : constant C_Int := C_Use_Default_Colors;
2447 if Err = Curses_Err then
2448 raise Curses_Exception;
2450 end Use_Default_Colors;
2452 procedure Assume_Default_Colors (Fore : Color_Number := Default_Color;
2453 Back : Color_Number := Default_Color)
2455 function C_Assume_Default_Colors (Fore : C_Int;
2456 Back : C_Int) return C_Int;
2457 pragma Import (C, C_Assume_Default_Colors, "assume_default_colors");
2459 Err : constant C_Int := C_Assume_Default_Colors (C_Int (Fore),
2462 if Err = Curses_Err then
2463 raise Curses_Exception;
2465 end Assume_Default_Colors;
2466 ------------------------------------------------------------------------------
2467 function Curses_Version return String
2469 function curses_versionC return chars_ptr;
2470 pragma Import (C, curses_versionC, "curses_version");
2471 Result : constant chars_ptr := curses_versionC;
2473 return Fill_String (Result);
2475 ------------------------------------------------------------------------------
2476 function Use_Extended_Names (Enable : Boolean) return Boolean
2478 function use_extended_namesC (e : Curses_Bool) return C_Int;
2479 pragma Import (C, use_extended_namesC, "use_extended_names");
2481 Res : constant C_Int :=
2482 use_extended_namesC (Curses_Bool (Boolean'Pos (Enable)));
2484 if Res = C_Int (Curses_Bool_False) then
2489 end Use_Extended_Names;
2490 ------------------------------------------------------------------------------
2491 procedure Screen_Dump_To_File (Filename : in String)
2493 function scr_dump (f : char_array) return C_Int;
2494 pragma Import (C, scr_dump, "scr_dump");
2495 Txt : char_array (0 .. Filename'Length);
2498 To_C (Filename, Txt, Length);
2499 if Curses_Err = scr_dump (Txt) then
2500 raise Curses_Exception;
2502 end Screen_Dump_To_File;
2504 procedure Screen_Restore_From_File (Filename : in String)
2506 function scr_restore (f : char_array) return C_Int;
2507 pragma Import (C, scr_restore, "scr_restore");
2508 Txt : char_array (0 .. Filename'Length);
2511 To_C (Filename, Txt, Length);
2512 if Curses_Err = scr_restore (Txt) then
2513 raise Curses_Exception;
2515 end Screen_Restore_From_File;
2517 procedure Screen_Init_From_File (Filename : in String)
2519 function scr_init (f : char_array) return C_Int;
2520 pragma Import (C, scr_init, "scr_init");
2521 Txt : char_array (0 .. Filename'Length);
2524 To_C (Filename, Txt, Length);
2525 if Curses_Err = scr_init (Txt) then
2526 raise Curses_Exception;
2528 end Screen_Init_From_File;
2530 procedure Screen_Set_File (Filename : in String)
2532 function scr_set (f : char_array) return C_Int;
2533 pragma Import (C, scr_set, "scr_set");
2534 Txt : char_array (0 .. Filename'Length);
2537 To_C (Filename, Txt, Length);
2538 if Curses_Err = scr_set (Txt) then
2539 raise Curses_Exception;
2541 end Screen_Set_File;
2542 ------------------------------------------------------------------------------
2543 procedure Resize (Win : Window := Standard_Window;
2544 Number_Of_Lines : Line_Count;
2545 Number_Of_Columns : Column_Count) is
2546 function wresize (win : Window;
2548 columns : C_Int) return C_Int;
2549 pragma Import (C, wresize);
2552 C_Int (Number_Of_Lines),
2553 C_Int (Number_Of_Columns)) = Curses_Err then
2554 raise Curses_Exception;
2557 ------------------------------------------------------------------------------
2559 end Terminal_Interface.Curses;