2 define(`HTMLNAME',`terminal_interface-curses__adb.htm')dnl
3 include(M4MACRO)------------------------------------------------------------------------------
5 -- GNAT ncurses Binding --
7 -- Terminal_Interface.Curses --
11 ------------------------------------------------------------------------------
12 -- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. --
14 -- Permission is hereby granted, free of charge, to any person obtaining a --
15 -- copy of this software and associated documentation files (the --
16 -- "Software"), to deal in the Software without restriction, including --
17 -- without limitation the rights to use, copy, modify, merge, publish, --
18 -- distribute, distribute with modifications, sublicense, and/or sell --
19 -- copies of the Software, and to permit persons to whom the Software is --
20 -- furnished to do so, subject to the following conditions: --
22 -- The above copyright notice and this permission notice shall be included --
23 -- in all copies or substantial portions of the Software. --
25 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
26 -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
27 -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
28 -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
29 -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
30 -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
31 -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
33 -- Except as contained in this notice, the name(s) of the above copyright --
34 -- holders shall not be used in advertising or otherwise to promote the --
35 -- sale, use or other dealings in this Software without prior written --
37 ------------------------------------------------------------------------------
38 -- Author: Juergen Pfeifer, 1996
41 -- $Date: 2011/03/19 16:17:19 $
42 -- Binding Version 01.00
43 ------------------------------------------------------------------------------
46 with Terminal_Interface.Curses.Aux;
47 with Interfaces.C; use Interfaces.C;
48 with Interfaces.C.Strings; use Interfaces.C.Strings;
49 with Ada.Characters.Handling; use Ada.Characters.Handling;
50 with Ada.Strings.Fixed;
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 ------------------------------------------------------------------------------
64 function Key_Name (Key : Real_Key_Code) return String
66 function Keyname (K : C_Int) return chars_ptr;
67 pragma Import (C, Keyname, "keyname");
71 if Key <= Character'Pos (Character'Last) then
72 Ch := Character'Val (Key);
73 if Is_Control (Ch) then
74 return Un_Control (Attributed_Character'(Ch => Ch,
75 Color => Color_Pair'First,
76 Attr => Normal_Video));
77 elsif Is_Graphic (Ch) then
88 return Fill_String (Keyname (C_Int (Key)));
92 procedure Key_Name (Key : Real_Key_Code;
96 ASF.Move (Key_Name (Key), Name);
99 ------------------------------------------------------------------------------
100 procedure Init_Screen
102 function Initscr return Window;
103 pragma Import (C, Initscr, "initscr");
108 if W = Null_Window then
109 raise Curses_Exception;
113 procedure End_Windows
115 function Endwin return C_Int;
116 pragma Import (C, Endwin, "endwin");
118 if Endwin = Curses_Err then
119 raise Curses_Exception;
123 function Is_End_Window return Boolean
125 function Isendwin return Curses_Bool;
126 pragma Import (C, Isendwin, "isendwin");
128 if Isendwin = Curses_Bool_False then
134 ------------------------------------------------------------------------------
135 procedure Move_Cursor (Win : Window := Standard_Window;
136 Line : Line_Position;
137 Column : Column_Position)
139 function Wmove (Win : Window;
143 pragma Import (C, Wmove, "wmove");
145 if Wmove (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
146 raise Curses_Exception;
149 ------------------------------------------------------------------------------
150 procedure Add (Win : Window := Standard_Window;
151 Ch : Attributed_Character)
153 function Waddch (W : Window;
154 Ch : C_Chtype) return C_Int;
155 pragma Import (C, Waddch, "waddch");
157 if Waddch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
158 raise Curses_Exception;
162 procedure Add (Win : Window := Standard_Window;
167 Attributed_Character'(Ch => Ch,
168 Color => Color_Pair'First,
169 Attr => Normal_Video));
173 (Win : Window := Standard_Window;
174 Line : Line_Position;
175 Column : Column_Position;
176 Ch : Attributed_Character)
178 function mvwaddch (W : Window;
181 Ch : C_Chtype) return C_Int;
182 pragma Import (C, mvwaddch, "mvwaddch");
184 if mvwaddch (Win, C_Int (Line),
186 AttrChar_To_Chtype (Ch)) = Curses_Err then
187 raise Curses_Exception;
192 (Win : Window := Standard_Window;
193 Line : Line_Position;
194 Column : Column_Position;
201 Attributed_Character'(Ch => Ch,
202 Color => Color_Pair'First,
203 Attr => Normal_Video));
206 procedure Add_With_Immediate_Echo
207 (Win : Window := Standard_Window;
208 Ch : Attributed_Character)
210 function Wechochar (W : Window;
211 Ch : C_Chtype) return C_Int;
212 pragma Import (C, Wechochar, "wechochar");
214 if Wechochar (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
215 raise Curses_Exception;
217 end Add_With_Immediate_Echo;
219 procedure Add_With_Immediate_Echo
220 (Win : Window := Standard_Window;
224 Add_With_Immediate_Echo
226 Attributed_Character'(Ch => Ch,
227 Color => Color_Pair'First,
228 Attr => Normal_Video));
229 end Add_With_Immediate_Echo;
230 ------------------------------------------------------------------------------
231 function Create (Number_Of_Lines : Line_Count;
232 Number_Of_Columns : Column_Count;
233 First_Line_Position : Line_Position;
234 First_Column_Position : Column_Position) return Window
236 function Newwin (Number_Of_Lines : C_Int;
237 Number_Of_Columns : C_Int;
238 First_Line_Position : C_Int;
239 First_Column_Position : C_Int) return Window;
240 pragma Import (C, Newwin, "newwin");
244 W := Newwin (C_Int (Number_Of_Lines),
245 C_Int (Number_Of_Columns),
246 C_Int (First_Line_Position),
247 C_Int (First_Column_Position));
248 if W = Null_Window then
249 raise Curses_Exception;
254 procedure Delete (Win : in out Window)
256 function Wdelwin (W : Window) return C_Int;
257 pragma Import (C, Wdelwin, "delwin");
259 if Wdelwin (Win) = Curses_Err then
260 raise Curses_Exception;
266 (Win : Window := Standard_Window;
267 Number_Of_Lines : Line_Count;
268 Number_Of_Columns : Column_Count;
269 First_Line_Position : Line_Position;
270 First_Column_Position : Column_Position) return Window
274 Number_Of_Lines : C_Int;
275 Number_Of_Columns : C_Int;
276 First_Line_Position : C_Int;
277 First_Column_Position : C_Int) return Window;
278 pragma Import (C, Subwin, "subwin");
283 C_Int (Number_Of_Lines),
284 C_Int (Number_Of_Columns),
285 C_Int (First_Line_Position),
286 C_Int (First_Column_Position));
287 if W = Null_Window then
288 raise Curses_Exception;
293 function Derived_Window
294 (Win : Window := Standard_Window;
295 Number_Of_Lines : Line_Count;
296 Number_Of_Columns : Column_Count;
297 First_Line_Position : Line_Position;
298 First_Column_Position : Column_Position) return Window
302 Number_Of_Lines : C_Int;
303 Number_Of_Columns : C_Int;
304 First_Line_Position : C_Int;
305 First_Column_Position : C_Int) return Window;
306 pragma Import (C, Derwin, "derwin");
311 C_Int (Number_Of_Lines),
312 C_Int (Number_Of_Columns),
313 C_Int (First_Line_Position),
314 C_Int (First_Column_Position));
315 if W = Null_Window then
316 raise Curses_Exception;
321 function Duplicate (Win : Window) return Window
323 function Dupwin (Win : Window) return Window;
324 pragma Import (C, Dupwin, "dupwin");
326 W : constant Window := Dupwin (Win);
328 if W = Null_Window then
329 raise Curses_Exception;
334 procedure Move_Window (Win : Window;
335 Line : Line_Position;
336 Column : Column_Position)
338 function Mvwin (Win : Window;
340 Column : C_Int) return C_Int;
341 pragma Import (C, Mvwin, "mvwin");
343 if Mvwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
344 raise Curses_Exception;
348 procedure Move_Derived_Window (Win : Window;
349 Line : Line_Position;
350 Column : Column_Position)
352 function Mvderwin (Win : Window;
354 Column : C_Int) return C_Int;
355 pragma Import (C, Mvderwin, "mvderwin");
357 if Mvderwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
358 raise Curses_Exception;
360 end Move_Derived_Window;
362 procedure Set_Synch_Mode (Win : Window := Standard_Window;
363 Mode : Boolean := False)
365 function Syncok (Win : Window;
366 Mode : Curses_Bool) return C_Int;
367 pragma Import (C, Syncok, "syncok");
369 if Syncok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
370 raise Curses_Exception;
373 ------------------------------------------------------------------------------
374 procedure Add (Win : Window := Standard_Window;
378 function Waddnstr (Win : Window;
380 Len : C_Int := -1) return C_Int;
381 pragma Import (C, Waddnstr, "waddnstr");
383 Txt : char_array (0 .. Str'Length);
386 To_C (Str, Txt, Length);
387 if Waddnstr (Win, Txt, C_Int (Len)) = Curses_Err then
388 raise Curses_Exception;
393 (Win : Window := Standard_Window;
394 Line : Line_Position;
395 Column : Column_Position;
400 Move_Cursor (Win, Line, Column);
403 ------------------------------------------------------------------------------
405 (Win : Window := Standard_Window;
406 Str : Attributed_String;
409 function Waddchnstr (Win : Window;
411 Len : C_Int := -1) return C_Int;
412 pragma Import (C, Waddchnstr, "waddchnstr");
414 Txt : chtype_array (0 .. Str'Length);
416 for Length in 1 .. size_t (Str'Length) loop
417 Txt (Length - 1) := Str (Natural (Length));
419 Txt (Str'Length) := Default_Character;
422 C_Int (Len)) = Curses_Err then
423 raise Curses_Exception;
428 (Win : Window := Standard_Window;
429 Line : Line_Position;
430 Column : Column_Position;
431 Str : Attributed_String;
435 Move_Cursor (Win, Line, Column);
438 ------------------------------------------------------------------------------
440 (Win : Window := Standard_Window;
441 Left_Side_Symbol : Attributed_Character := Default_Character;
442 Right_Side_Symbol : Attributed_Character := Default_Character;
443 Top_Side_Symbol : Attributed_Character := Default_Character;
444 Bottom_Side_Symbol : Attributed_Character := Default_Character;
445 Upper_Left_Corner_Symbol : Attributed_Character := Default_Character;
446 Upper_Right_Corner_Symbol : Attributed_Character := Default_Character;
447 Lower_Left_Corner_Symbol : Attributed_Character := Default_Character;
448 Lower_Right_Corner_Symbol : Attributed_Character := Default_Character)
450 function Wborder (W : Window;
458 LRC : C_Chtype) return C_Int;
459 pragma Import (C, Wborder, "wborder");
462 AttrChar_To_Chtype (Left_Side_Symbol),
463 AttrChar_To_Chtype (Right_Side_Symbol),
464 AttrChar_To_Chtype (Top_Side_Symbol),
465 AttrChar_To_Chtype (Bottom_Side_Symbol),
466 AttrChar_To_Chtype (Upper_Left_Corner_Symbol),
467 AttrChar_To_Chtype (Upper_Right_Corner_Symbol),
468 AttrChar_To_Chtype (Lower_Left_Corner_Symbol),
469 AttrChar_To_Chtype (Lower_Right_Corner_Symbol)
472 raise Curses_Exception;
477 (Win : Window := Standard_Window;
478 Vertical_Symbol : Attributed_Character := Default_Character;
479 Horizontal_Symbol : Attributed_Character := Default_Character)
483 Vertical_Symbol, Vertical_Symbol,
484 Horizontal_Symbol, Horizontal_Symbol);
487 procedure Horizontal_Line
488 (Win : Window := Standard_Window;
490 Line_Symbol : Attributed_Character := Default_Character)
492 function Whline (W : Window;
494 Len : C_Int) return C_Int;
495 pragma Import (C, Whline, "whline");
498 AttrChar_To_Chtype (Line_Symbol),
499 C_Int (Line_Size)) = Curses_Err then
500 raise Curses_Exception;
504 procedure Vertical_Line
505 (Win : Window := Standard_Window;
507 Line_Symbol : Attributed_Character := Default_Character)
509 function Wvline (W : Window;
511 Len : C_Int) return C_Int;
512 pragma Import (C, Wvline, "wvline");
515 AttrChar_To_Chtype (Line_Symbol),
516 C_Int (Line_Size)) = Curses_Err then
517 raise Curses_Exception;
521 ------------------------------------------------------------------------------
522 function Get_Keystroke (Win : Window := Standard_Window)
525 function Wgetch (W : Window) return C_Int;
526 pragma Import (C, Wgetch, "wgetch");
528 C : constant C_Int := Wgetch (Win);
530 if C = Curses_Err then
533 return Real_Key_Code (C);
537 procedure Undo_Keystroke (Key : Real_Key_Code)
539 function Ungetch (Ch : C_Int) return C_Int;
540 pragma Import (C, Ungetch, "ungetch");
542 if Ungetch (C_Int (Key)) = Curses_Err then
543 raise Curses_Exception;
547 function Has_Key (Key : Special_Key_Code) return Boolean
549 function Haskey (Key : C_Int) return C_Int;
550 pragma Import (C, Haskey, "has_key");
552 if Haskey (C_Int (Key)) = Curses_False then
559 function Is_Function_Key (Key : Special_Key_Code) return Boolean
561 L : constant Special_Key_Code := Special_Key_Code (Natural (Key_F0) +
562 Natural (Function_Key_Number'Last));
564 if (Key >= Key_F0) and then (Key <= L) then
571 function Function_Key (Key : Real_Key_Code)
572 return Function_Key_Number
575 if Is_Function_Key (Key) then
576 return Function_Key_Number (Key - Key_F0);
578 raise Constraint_Error;
582 function Function_Key_Code (Key : Function_Key_Number) return Real_Key_Code
585 return Real_Key_Code (Natural (Key_F0) + Natural (Key));
586 end Function_Key_Code;
587 ------------------------------------------------------------------------------
588 procedure Standout (Win : Window := Standard_Window;
589 On : Boolean := True)
591 function wstandout (Win : Window) return C_Int;
592 pragma Import (C, wstandout, "wstandout");
593 function wstandend (Win : Window) return C_Int;
594 pragma Import (C, wstandend, "wstandend");
599 Err := wstandout (Win);
601 Err := wstandend (Win);
603 if Err = Curses_Err then
604 raise Curses_Exception;
608 procedure Switch_Character_Attribute
609 (Win : Window := Standard_Window;
610 Attr : Character_Attribute_Set := Normal_Video;
611 On : Boolean := True)
613 function Wattron (Win : Window;
614 C_Attr : C_AttrType) return C_Int;
615 pragma Import (C, Wattron, "wattr_on");
616 function Wattroff (Win : Window;
617 C_Attr : C_AttrType) return C_Int;
618 pragma Import (C, Wattroff, "wattr_off");
619 -- In Ada we use the On Boolean to control whether or not we want to
620 -- switch on or off the attributes in the set.
622 AC : constant Attributed_Character := (Ch => Character'First,
623 Color => Color_Pair'First,
627 Err := Wattron (Win, AttrChar_To_AttrType (AC));
629 Err := Wattroff (Win, AttrChar_To_AttrType (AC));
631 if Err = Curses_Err then
632 raise Curses_Exception;
634 end Switch_Character_Attribute;
636 procedure Set_Character_Attributes
637 (Win : Window := Standard_Window;
638 Attr : Character_Attribute_Set := Normal_Video;
639 Color : Color_Pair := Color_Pair'First)
641 function Wattrset (Win : Window;
642 C_Attr : C_AttrType) return C_Int;
643 pragma Import (C, Wattrset, "wattrset"); -- ??? wattr_set
646 AttrChar_To_AttrType (Attributed_Character'
647 (Ch => Character'First,
649 Attr => Attr))) = Curses_Err then
650 raise Curses_Exception;
652 end Set_Character_Attributes;
654 function Get_Character_Attribute (Win : Window := Standard_Window)
655 return Character_Attribute_Set
657 function Wattrget (Win : Window;
658 Atr : access C_AttrType;
659 Col : access C_Short;
660 Opt : System.Address) return C_Int;
661 pragma Import (C, Wattrget, "wattr_get");
663 Attr : aliased C_AttrType;
664 Col : aliased C_Short;
665 Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
666 System.Null_Address);
667 Ch : Attributed_Character;
669 if Res = Curses_Ok then
670 Ch := AttrType_To_AttrChar (Attr);
673 raise Curses_Exception;
675 end Get_Character_Attribute;
677 function Get_Character_Attribute (Win : Window := Standard_Window)
680 function Wattrget (Win : Window;
681 Atr : access C_AttrType;
682 Col : access C_Short;
683 Opt : System.Address) return C_Int;
684 pragma Import (C, Wattrget, "wattr_get");
686 Attr : aliased C_AttrType;
687 Col : aliased C_Short;
688 Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
689 System.Null_Address);
690 Ch : Attributed_Character;
692 if Res = Curses_Ok then
693 Ch := AttrType_To_AttrChar (Attr);
696 raise Curses_Exception;
698 end Get_Character_Attribute;
700 procedure Set_Color (Win : Window := Standard_Window;
703 function Wset_Color (Win : Window;
705 Opts : C_Void_Ptr) return C_Int;
706 pragma Import (C, Wset_Color, "wcolor_set");
710 C_Void_Ptr (System.Null_Address)) = Curses_Err then
711 raise Curses_Exception;
715 procedure Change_Attributes
716 (Win : Window := Standard_Window;
717 Count : Integer := -1;
718 Attr : Character_Attribute_Set := Normal_Video;
719 Color : Color_Pair := Color_Pair'First)
721 function Wchgat (Win : Window;
725 Opts : System.Address := System.Null_Address)
727 pragma Import (C, Wchgat, "wchgat");
729 Ch : constant Attributed_Character :=
730 (Ch => Character'First, Color => Color_Pair'First, Attr => Attr);
732 if Wchgat (Win, C_Int (Count), AttrChar_To_AttrType (Ch),
733 C_Short (Color)) = Curses_Err then
734 raise Curses_Exception;
736 end Change_Attributes;
738 procedure Change_Attributes
739 (Win : Window := Standard_Window;
740 Line : Line_Position := Line_Position'First;
741 Column : Column_Position := Column_Position'First;
742 Count : Integer := -1;
743 Attr : Character_Attribute_Set := Normal_Video;
744 Color : Color_Pair := Color_Pair'First)
747 Move_Cursor (Win, Line, Column);
748 Change_Attributes (Win, Count, Attr, Color);
749 end Change_Attributes;
750 ------------------------------------------------------------------------------
753 function Beeper return C_Int;
754 pragma Import (C, Beeper, "beep");
756 if Beeper = Curses_Err then
757 raise Curses_Exception;
761 procedure Flash_Screen
763 function Flash return C_Int;
764 pragma Import (C, Flash, "flash");
766 if Flash = Curses_Err then
767 raise Curses_Exception;
770 ------------------------------------------------------------------------------
771 procedure Set_Cbreak_Mode (SwitchOn : Boolean := True)
773 function Cbreak return C_Int;
774 pragma Import (C, Cbreak, "cbreak");
775 function NoCbreak return C_Int;
776 pragma Import (C, NoCbreak, "nocbreak");
785 if Err = Curses_Err then
786 raise Curses_Exception;
790 procedure Set_Raw_Mode (SwitchOn : Boolean := True)
792 function Raw return C_Int;
793 pragma Import (C, Raw, "raw");
794 function NoRaw return C_Int;
795 pragma Import (C, NoRaw, "noraw");
804 if Err = Curses_Err then
805 raise Curses_Exception;
809 procedure Set_Echo_Mode (SwitchOn : Boolean := True)
811 function Echo return C_Int;
812 pragma Import (C, Echo, "echo");
813 function NoEcho return C_Int;
814 pragma Import (C, NoEcho, "noecho");
823 if Err = Curses_Err then
824 raise Curses_Exception;
828 procedure Set_Meta_Mode (Win : Window := Standard_Window;
829 SwitchOn : Boolean := True)
831 function Meta (W : Window; Mode : Curses_Bool) return C_Int;
832 pragma Import (C, Meta, "meta");
834 if Meta (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then
835 raise Curses_Exception;
839 procedure Set_KeyPad_Mode (Win : Window := Standard_Window;
840 SwitchOn : Boolean := True)
842 function Keypad (W : Window; Mode : Curses_Bool) return C_Int;
843 pragma Import (C, Keypad, "keypad");
845 if Keypad (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then
846 raise Curses_Exception;
850 function Get_KeyPad_Mode (Win : Window := Standard_Window)
853 function Is_Keypad (W : Window) return Curses_Bool;
854 pragma Import (C, Is_Keypad, "is_keypad");
856 return (Is_Keypad (Win) /= Curses_Bool_False);
859 procedure Half_Delay (Amount : Half_Delay_Amount)
861 function Halfdelay (Amount : C_Int) return C_Int;
862 pragma Import (C, Halfdelay, "halfdelay");
864 if Halfdelay (C_Int (Amount)) = Curses_Err then
865 raise Curses_Exception;
869 procedure Set_Flush_On_Interrupt_Mode
870 (Win : Window := Standard_Window;
871 Mode : Boolean := True)
873 function Intrflush (Win : Window; Mode : Curses_Bool) return C_Int;
874 pragma Import (C, Intrflush, "intrflush");
876 if Intrflush (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
877 raise Curses_Exception;
879 end Set_Flush_On_Interrupt_Mode;
881 procedure Set_Queue_Interrupt_Mode
882 (Win : Window := Standard_Window;
883 Flush : Boolean := True)
886 pragma Import (C, Qiflush, "qiflush");
887 procedure No_Qiflush;
888 pragma Import (C, No_Qiflush, "noqiflush");
890 if Win = Null_Window then
891 raise Curses_Exception;
898 end Set_Queue_Interrupt_Mode;
900 procedure Set_NoDelay_Mode
901 (Win : Window := Standard_Window;
902 Mode : Boolean := False)
904 function Nodelay (Win : Window; Mode : Curses_Bool) return C_Int;
905 pragma Import (C, Nodelay, "nodelay");
907 if Nodelay (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
908 raise Curses_Exception;
910 end Set_NoDelay_Mode;
912 procedure Set_Timeout_Mode (Win : Window := Standard_Window;
916 procedure Wtimeout (Win : Window; Amount : C_Int);
917 pragma Import (C, Wtimeout, "wtimeout");
922 when Blocking => Time := -1;
923 when Non_Blocking => Time := 0;
926 raise Constraint_Error;
928 Time := C_Int (Amount);
930 Wtimeout (Win, Time);
931 end Set_Timeout_Mode;
933 procedure Set_Escape_Timer_Mode
934 (Win : Window := Standard_Window;
935 Timer_Off : Boolean := False)
937 function Notimeout (Win : Window; Mode : Curses_Bool) return C_Int;
938 pragma Import (C, Notimeout, "notimeout");
940 if Notimeout (Win, Curses_Bool (Boolean'Pos (Timer_Off)))
942 raise Curses_Exception;
944 end Set_Escape_Timer_Mode;
946 ------------------------------------------------------------------------------
947 procedure Set_NL_Mode (SwitchOn : Boolean := True)
949 function NL return C_Int;
950 pragma Import (C, NL, "nl");
951 function NoNL return C_Int;
952 pragma Import (C, NoNL, "nonl");
961 if Err = Curses_Err then
962 raise Curses_Exception;
966 procedure Clear_On_Next_Update
967 (Win : Window := Standard_Window;
968 Do_Clear : Boolean := True)
970 function Clear_Ok (W : Window; Flag : Curses_Bool) return C_Int;
971 pragma Import (C, Clear_Ok, "clearok");
973 if Clear_Ok (Win, Curses_Bool (Boolean'Pos (Do_Clear))) = Curses_Err then
974 raise Curses_Exception;
976 end Clear_On_Next_Update;
978 procedure Use_Insert_Delete_Line
979 (Win : Window := Standard_Window;
980 Do_Idl : Boolean := True)
982 function IDL_Ok (W : Window; Flag : Curses_Bool) return C_Int;
983 pragma Import (C, IDL_Ok, "idlok");
985 if IDL_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idl))) = Curses_Err then
986 raise Curses_Exception;
988 end Use_Insert_Delete_Line;
990 procedure Use_Insert_Delete_Character
991 (Win : Window := Standard_Window;
992 Do_Idc : Boolean := True)
994 procedure IDC_Ok (W : Window; Flag : Curses_Bool);
995 pragma Import (C, IDC_Ok, "idcok");
997 IDC_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idc)));
998 end Use_Insert_Delete_Character;
1000 procedure Leave_Cursor_After_Update
1001 (Win : Window := Standard_Window;
1002 Do_Leave : Boolean := True)
1004 function Leave_Ok (W : Window; Flag : Curses_Bool) return C_Int;
1005 pragma Import (C, Leave_Ok, "leaveok");
1007 if Leave_Ok (Win, Curses_Bool (Boolean'Pos (Do_Leave))) = Curses_Err then
1008 raise Curses_Exception;
1010 end Leave_Cursor_After_Update;
1012 procedure Immediate_Update_Mode
1013 (Win : Window := Standard_Window;
1014 Mode : Boolean := False)
1016 procedure Immedok (Win : Window; Mode : Curses_Bool);
1017 pragma Import (C, Immedok, "immedok");
1019 Immedok (Win, Curses_Bool (Boolean'Pos (Mode)));
1020 end Immediate_Update_Mode;
1022 procedure Allow_Scrolling
1023 (Win : Window := Standard_Window;
1024 Mode : Boolean := False)
1026 function Scrollok (Win : Window; Mode : Curses_Bool) return C_Int;
1027 pragma Import (C, Scrollok, "scrollok");
1029 if Scrollok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
1030 raise Curses_Exception;
1032 end Allow_Scrolling;
1034 function Scrolling_Allowed (Win : Window := Standard_Window)
1037 function Is_Scroll_Ok (W : Window) return Curses_Bool;
1038 pragma Import (C, Is_Scroll_Ok, "is_scrollok");
1040 return (Is_Scroll_Ok (Win) /= Curses_Bool_False);
1041 end Scrolling_Allowed;
1043 procedure Set_Scroll_Region
1044 (Win : Window := Standard_Window;
1045 Top_Line : Line_Position;
1046 Bottom_Line : Line_Position)
1048 function Wsetscrreg (Win : Window;
1050 Col : C_Int) return C_Int;
1051 pragma Import (C, Wsetscrreg, "wsetscrreg");
1053 if Wsetscrreg (Win, C_Int (Top_Line), C_Int (Bottom_Line))
1055 raise Curses_Exception;
1057 end Set_Scroll_Region;
1058 ------------------------------------------------------------------------------
1059 procedure Update_Screen
1061 function Do_Update return C_Int;
1062 pragma Import (C, Do_Update, "doupdate");
1064 if Do_Update = Curses_Err then
1065 raise Curses_Exception;
1069 procedure Refresh (Win : Window := Standard_Window)
1071 function Wrefresh (W : Window) return C_Int;
1072 pragma Import (C, Wrefresh, "wrefresh");
1074 if Wrefresh (Win) = Curses_Err then
1075 raise Curses_Exception;
1079 procedure Refresh_Without_Update
1080 (Win : Window := Standard_Window)
1082 function Wnoutrefresh (W : Window) return C_Int;
1083 pragma Import (C, Wnoutrefresh, "wnoutrefresh");
1085 if Wnoutrefresh (Win) = Curses_Err then
1086 raise Curses_Exception;
1088 end Refresh_Without_Update;
1090 procedure Redraw (Win : Window := Standard_Window)
1092 function Redrawwin (Win : Window) return C_Int;
1093 pragma Import (C, Redrawwin, "redrawwin");
1095 if Redrawwin (Win) = Curses_Err then
1096 raise Curses_Exception;
1101 (Win : Window := Standard_Window;
1102 Begin_Line : Line_Position;
1103 Line_Count : Positive)
1105 function Wredrawln (Win : Window; First : C_Int; Cnt : C_Int)
1107 pragma Import (C, Wredrawln, "wredrawln");
1111 C_Int (Line_Count)) = Curses_Err then
1112 raise Curses_Exception;
1116 ------------------------------------------------------------------------------
1117 procedure Erase (Win : Window := Standard_Window)
1119 function Werase (W : Window) return C_Int;
1120 pragma Import (C, Werase, "werase");
1122 if Werase (Win) = Curses_Err then
1123 raise Curses_Exception;
1127 procedure Clear (Win : Window := Standard_Window)
1129 function Wclear (W : Window) return C_Int;
1130 pragma Import (C, Wclear, "wclear");
1132 if Wclear (Win) = Curses_Err then
1133 raise Curses_Exception;
1137 procedure Clear_To_End_Of_Screen (Win : Window := Standard_Window)
1139 function Wclearbot (W : Window) return C_Int;
1140 pragma Import (C, Wclearbot, "wclrtobot");
1142 if Wclearbot (Win) = Curses_Err then
1143 raise Curses_Exception;
1145 end Clear_To_End_Of_Screen;
1147 procedure Clear_To_End_Of_Line (Win : Window := Standard_Window)
1149 function Wcleareol (W : Window) return C_Int;
1150 pragma Import (C, Wcleareol, "wclrtoeol");
1152 if Wcleareol (Win) = Curses_Err then
1153 raise Curses_Exception;
1155 end Clear_To_End_Of_Line;
1156 ------------------------------------------------------------------------------
1157 procedure Set_Background
1158 (Win : Window := Standard_Window;
1159 Ch : Attributed_Character)
1161 procedure WBackground (W : Window; Ch : C_Chtype);
1162 pragma Import (C, WBackground, "wbkgdset");
1164 WBackground (Win, AttrChar_To_Chtype (Ch));
1167 procedure Change_Background
1168 (Win : Window := Standard_Window;
1169 Ch : Attributed_Character)
1171 function WChangeBkgd (W : Window; Ch : C_Chtype) return C_Int;
1172 pragma Import (C, WChangeBkgd, "wbkgd");
1174 if WChangeBkgd (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
1175 raise Curses_Exception;
1177 end Change_Background;
1179 function Get_Background (Win : Window := Standard_Window)
1180 return Attributed_Character
1182 function Wgetbkgd (Win : Window) return C_Chtype;
1183 pragma Import (C, Wgetbkgd, "getbkgd");
1185 return Chtype_To_AttrChar (Wgetbkgd (Win));
1187 ------------------------------------------------------------------------------
1188 procedure Change_Lines_Status (Win : Window := Standard_Window;
1189 Start : Line_Position;
1193 function Wtouchln (Win : Window;
1196 Chg : C_Int) return C_Int;
1197 pragma Import (C, Wtouchln, "wtouchln");
1199 if Wtouchln (Win, C_Int (Start), C_Int (Count),
1200 C_Int (Boolean'Pos (State))) = Curses_Err then
1201 raise Curses_Exception;
1203 end Change_Lines_Status;
1205 procedure Touch (Win : Window := Standard_Window)
1208 X : Column_Position;
1210 Get_Size (Win, Y, X);
1211 Change_Lines_Status (Win, 0, Positive (Y), True);
1214 procedure Untouch (Win : Window := Standard_Window)
1217 X : Column_Position;
1219 Get_Size (Win, Y, X);
1220 Change_Lines_Status (Win, 0, Positive (Y), False);
1223 procedure Touch (Win : Window := Standard_Window;
1224 Start : Line_Position;
1228 Change_Lines_Status (Win, Start, Count, True);
1232 (Win : Window := Standard_Window;
1233 Line : Line_Position) return Boolean
1235 function WLineTouched (W : Window; L : C_Int) return Curses_Bool;
1236 pragma Import (C, WLineTouched, "is_linetouched");
1238 if WLineTouched (Win, C_Int (Line)) = Curses_Bool_False then
1246 (Win : Window := Standard_Window) return Boolean
1248 function WWinTouched (W : Window) return Curses_Bool;
1249 pragma Import (C, WWinTouched, "is_wintouched");
1251 if WWinTouched (Win) = Curses_Bool_False then
1257 ------------------------------------------------------------------------------
1259 (Source_Window : Window;
1260 Destination_Window : Window;
1261 Source_Top_Row : Line_Position;
1262 Source_Left_Column : Column_Position;
1263 Destination_Top_Row : Line_Position;
1264 Destination_Left_Column : Column_Position;
1265 Destination_Bottom_Row : Line_Position;
1266 Destination_Right_Column : Column_Position;
1267 Non_Destructive_Mode : Boolean := True)
1269 function Copywin (Src : Window;
1277 Ndm : C_Int) return C_Int;
1278 pragma Import (C, Copywin, "copywin");
1280 if Copywin (Source_Window,
1282 C_Int (Source_Top_Row),
1283 C_Int (Source_Left_Column),
1284 C_Int (Destination_Top_Row),
1285 C_Int (Destination_Left_Column),
1286 C_Int (Destination_Bottom_Row),
1287 C_Int (Destination_Right_Column),
1288 Boolean'Pos (Non_Destructive_Mode)
1290 raise Curses_Exception;
1295 (Source_Window : Window;
1296 Destination_Window : Window)
1298 function Overwrite (Src : Window; Dst : Window) return C_Int;
1299 pragma Import (C, Overwrite, "overwrite");
1301 if Overwrite (Source_Window, Destination_Window) = Curses_Err then
1302 raise Curses_Exception;
1307 (Source_Window : Window;
1308 Destination_Window : Window)
1310 function Overlay (Src : Window; Dst : Window) return C_Int;
1311 pragma Import (C, Overlay, "overlay");
1313 if Overlay (Source_Window, Destination_Window) = Curses_Err then
1314 raise Curses_Exception;
1318 ------------------------------------------------------------------------------
1319 procedure Insert_Delete_Lines
1320 (Win : Window := Standard_Window;
1321 Lines : Integer := 1) -- default is to insert one line above
1323 function Winsdelln (W : Window; N : C_Int) return C_Int;
1324 pragma Import (C, Winsdelln, "winsdelln");
1326 if Winsdelln (Win, C_Int (Lines)) = Curses_Err then
1327 raise Curses_Exception;
1329 end Insert_Delete_Lines;
1331 procedure Delete_Line (Win : Window := Standard_Window)
1334 Insert_Delete_Lines (Win, -1);
1337 procedure Insert_Line (Win : Window := Standard_Window)
1340 Insert_Delete_Lines (Win, 1);
1342 ------------------------------------------------------------------------------
1345 (Win : Window := Standard_Window;
1346 Number_Of_Lines : out Line_Count;
1347 Number_Of_Columns : out Column_Count)
1349 function GetMaxY (W : Window) return C_Int;
1350 pragma Import (C, GetMaxY, "getmaxy");
1352 function GetMaxX (W : Window) return C_Int;
1353 pragma Import (C, GetMaxX, "getmaxx");
1355 Y : constant C_Int := GetMaxY (Win);
1356 X : constant C_Int := GetMaxX (Win);
1358 Number_Of_Lines := Line_Count (Y);
1359 Number_Of_Columns := Column_Count (X);
1362 procedure Get_Window_Position
1363 (Win : Window := Standard_Window;
1364 Top_Left_Line : out Line_Position;
1365 Top_Left_Column : out Column_Position)
1367 function GetBegY (W : Window) return C_Int;
1368 pragma Import (C, GetBegY, "getbegy");
1370 function GetBegX (W : Window) return C_Int;
1371 pragma Import (C, GetBegX, "getbegx");
1373 Y : constant C_Short := C_Short (GetBegY (Win));
1374 X : constant C_Short := C_Short (GetBegX (Win));
1376 Top_Left_Line := Line_Position (Y);
1377 Top_Left_Column := Column_Position (X);
1378 end Get_Window_Position;
1380 procedure Get_Cursor_Position
1381 (Win : Window := Standard_Window;
1382 Line : out Line_Position;
1383 Column : out Column_Position)
1385 function GetCurY (W : Window) return C_Int;
1386 pragma Import (C, GetCurY, "getcury");
1388 function GetCurX (W : Window) return C_Int;
1389 pragma Import (C, GetCurX, "getcurx");
1391 Y : constant C_Short := C_Short (GetCurY (Win));
1392 X : constant C_Short := C_Short (GetCurX (Win));
1394 Line := Line_Position (Y);
1395 Column := Column_Position (X);
1396 end Get_Cursor_Position;
1398 procedure Get_Origin_Relative_To_Parent
1400 Top_Left_Line : out Line_Position;
1401 Top_Left_Column : out Column_Position;
1402 Is_Not_A_Subwindow : out Boolean)
1404 function GetParY (W : Window) return C_Int;
1405 pragma Import (C, GetParY, "getpary");
1407 function GetParX (W : Window) return C_Int;
1408 pragma Import (C, GetParX, "getparx");
1410 Y : constant C_Int := GetParY (Win);
1411 X : constant C_Int := GetParX (Win);
1414 Top_Left_Line := Line_Position'Last;
1415 Top_Left_Column := Column_Position'Last;
1416 Is_Not_A_Subwindow := True;
1418 Top_Left_Line := Line_Position (Y);
1419 Top_Left_Column := Column_Position (X);
1420 Is_Not_A_Subwindow := False;
1422 end Get_Origin_Relative_To_Parent;
1423 ------------------------------------------------------------------------------
1424 function New_Pad (Lines : Line_Count;
1425 Columns : Column_Count) return Window
1427 function Newpad (Lines : C_Int; Columns : C_Int) return Window;
1428 pragma Import (C, Newpad, "newpad");
1432 W := Newpad (C_Int (Lines), C_Int (Columns));
1433 if W = Null_Window then
1434 raise Curses_Exception;
1441 Number_Of_Lines : Line_Count;
1442 Number_Of_Columns : Column_Count;
1443 First_Line_Position : Line_Position;
1444 First_Column_Position : Column_Position) return Window
1448 Number_Of_Lines : C_Int;
1449 Number_Of_Columns : C_Int;
1450 First_Line_Position : C_Int;
1451 First_Column_Position : C_Int) return Window;
1452 pragma Import (C, Subpad, "subpad");
1457 C_Int (Number_Of_Lines),
1458 C_Int (Number_Of_Columns),
1459 C_Int (First_Line_Position),
1460 C_Int (First_Column_Position));
1461 if W = Null_Window then
1462 raise Curses_Exception;
1469 Source_Top_Row : Line_Position;
1470 Source_Left_Column : Column_Position;
1471 Destination_Top_Row : Line_Position;
1472 Destination_Left_Column : Column_Position;
1473 Destination_Bottom_Row : Line_Position;
1474 Destination_Right_Column : Column_Position)
1478 Source_Top_Row : C_Int;
1479 Source_Left_Column : C_Int;
1480 Destination_Top_Row : C_Int;
1481 Destination_Left_Column : C_Int;
1482 Destination_Bottom_Row : C_Int;
1483 Destination_Right_Column : C_Int) return C_Int;
1484 pragma Import (C, Prefresh, "prefresh");
1487 C_Int (Source_Top_Row),
1488 C_Int (Source_Left_Column),
1489 C_Int (Destination_Top_Row),
1490 C_Int (Destination_Left_Column),
1491 C_Int (Destination_Bottom_Row),
1492 C_Int (Destination_Right_Column)) = Curses_Err then
1493 raise Curses_Exception;
1497 procedure Refresh_Without_Update
1499 Source_Top_Row : Line_Position;
1500 Source_Left_Column : Column_Position;
1501 Destination_Top_Row : Line_Position;
1502 Destination_Left_Column : Column_Position;
1503 Destination_Bottom_Row : Line_Position;
1504 Destination_Right_Column : Column_Position)
1506 function Pnoutrefresh
1508 Source_Top_Row : C_Int;
1509 Source_Left_Column : C_Int;
1510 Destination_Top_Row : C_Int;
1511 Destination_Left_Column : C_Int;
1512 Destination_Bottom_Row : C_Int;
1513 Destination_Right_Column : C_Int) return C_Int;
1514 pragma Import (C, Pnoutrefresh, "pnoutrefresh");
1516 if Pnoutrefresh (Pad,
1517 C_Int (Source_Top_Row),
1518 C_Int (Source_Left_Column),
1519 C_Int (Destination_Top_Row),
1520 C_Int (Destination_Left_Column),
1521 C_Int (Destination_Bottom_Row),
1522 C_Int (Destination_Right_Column)) = Curses_Err then
1523 raise Curses_Exception;
1525 end Refresh_Without_Update;
1527 procedure Add_Character_To_Pad_And_Echo_It
1529 Ch : Attributed_Character)
1531 function Pechochar (Pad : Window; Ch : C_Chtype)
1533 pragma Import (C, Pechochar, "pechochar");
1535 if Pechochar (Pad, AttrChar_To_Chtype (Ch)) = Curses_Err then
1536 raise Curses_Exception;
1538 end Add_Character_To_Pad_And_Echo_It;
1540 procedure Add_Character_To_Pad_And_Echo_It
1545 Add_Character_To_Pad_And_Echo_It
1547 Attributed_Character'(Ch => Ch,
1548 Color => Color_Pair'First,
1549 Attr => Normal_Video));
1550 end Add_Character_To_Pad_And_Echo_It;
1551 ------------------------------------------------------------------------------
1552 procedure Scroll (Win : Window := Standard_Window;
1553 Amount : Integer := 1)
1555 function Wscrl (Win : Window; N : C_Int) return C_Int;
1556 pragma Import (C, Wscrl, "wscrl");
1559 if Wscrl (Win, C_Int (Amount)) = Curses_Err then
1560 raise Curses_Exception;
1564 ------------------------------------------------------------------------------
1565 procedure Delete_Character (Win : Window := Standard_Window)
1567 function Wdelch (Win : Window) return C_Int;
1568 pragma Import (C, Wdelch, "wdelch");
1570 if Wdelch (Win) = Curses_Err then
1571 raise Curses_Exception;
1573 end Delete_Character;
1575 procedure Delete_Character
1576 (Win : Window := Standard_Window;
1577 Line : Line_Position;
1578 Column : Column_Position)
1580 function Mvwdelch (Win : Window;
1582 Col : C_Int) return C_Int;
1583 pragma Import (C, Mvwdelch, "mvwdelch");
1585 if Mvwdelch (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
1586 raise Curses_Exception;
1588 end Delete_Character;
1589 ------------------------------------------------------------------------------
1590 function Peek (Win : Window := Standard_Window)
1591 return Attributed_Character
1593 function Winch (Win : Window) return C_Chtype;
1594 pragma Import (C, Winch, "winch");
1596 return Chtype_To_AttrChar (Winch (Win));
1600 (Win : Window := Standard_Window;
1601 Line : Line_Position;
1602 Column : Column_Position) return Attributed_Character
1604 function Mvwinch (Win : Window;
1606 Col : C_Int) return C_Chtype;
1607 pragma Import (C, Mvwinch, "mvwinch");
1609 return Chtype_To_AttrChar (Mvwinch (Win, C_Int (Line), C_Int (Column)));
1611 ------------------------------------------------------------------------------
1612 procedure Insert (Win : Window := Standard_Window;
1613 Ch : Attributed_Character)
1615 function Winsch (Win : Window; Ch : C_Chtype) return C_Int;
1616 pragma Import (C, Winsch, "winsch");
1618 if Winsch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
1619 raise Curses_Exception;
1624 (Win : Window := Standard_Window;
1625 Line : Line_Position;
1626 Column : Column_Position;
1627 Ch : Attributed_Character)
1629 function Mvwinsch (Win : Window;
1632 Ch : C_Chtype) return C_Int;
1633 pragma Import (C, Mvwinsch, "mvwinsch");
1638 AttrChar_To_Chtype (Ch)) = Curses_Err then
1639 raise Curses_Exception;
1642 ------------------------------------------------------------------------------
1643 procedure Insert (Win : Window := Standard_Window;
1645 Len : Integer := -1)
1647 function Winsnstr (Win : Window;
1649 Len : Integer := -1) return C_Int;
1650 pragma Import (C, Winsnstr, "winsnstr");
1652 Txt : char_array (0 .. Str'Length);
1655 To_C (Str, Txt, Length);
1656 if Winsnstr (Win, Txt, Len) = Curses_Err then
1657 raise Curses_Exception;
1662 (Win : Window := Standard_Window;
1663 Line : Line_Position;
1664 Column : Column_Position;
1666 Len : Integer := -1)
1668 function Mvwinsnstr (Win : Window;
1672 Len : C_Int) return C_Int;
1673 pragma Import (C, Mvwinsnstr, "mvwinsnstr");
1675 Txt : char_array (0 .. Str'Length);
1678 To_C (Str, Txt, Length);
1679 if Mvwinsnstr (Win, C_Int (Line), C_Int (Column), Txt, C_Int (Len))
1681 raise Curses_Exception;
1684 ------------------------------------------------------------------------------
1685 procedure Peek (Win : Window := Standard_Window;
1687 Len : Integer := -1)
1689 function Winnstr (Win : Window;
1691 Len : C_Int) return C_Int;
1692 pragma Import (C, Winnstr, "winnstr");
1695 Txt : char_array (0 .. Str'Length);
1701 if N > Str'Length then
1702 raise Constraint_Error;
1704 Txt (0) := Interfaces.C.char'First;
1705 if Winnstr (Win, Txt, C_Int (N)) = Curses_Err then
1706 raise Curses_Exception;
1708 To_Ada (Txt, Str, Cnt, True);
1709 if Cnt < Str'Length then
1710 Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
1715 (Win : Window := Standard_Window;
1716 Line : Line_Position;
1717 Column : Column_Position;
1719 Len : Integer := -1)
1722 Move_Cursor (Win, Line, Column);
1723 Peek (Win, Str, Len);
1725 ------------------------------------------------------------------------------
1727 (Win : Window := Standard_Window;
1728 Str : out Attributed_String;
1729 Len : Integer := -1)
1731 function Winchnstr (Win : Window;
1732 Str : chtype_array; -- out
1733 Len : C_Int) return C_Int;
1734 pragma Import (C, Winchnstr, "winchnstr");
1737 Txt : constant chtype_array (0 .. Str'Length)
1738 := (0 => Default_Character);
1744 if N > Str'Length then
1745 raise Constraint_Error;
1747 if Winchnstr (Win, Txt, C_Int (N)) = Curses_Err then
1748 raise Curses_Exception;
1750 for To in Str'Range loop
1751 exit when Txt (size_t (Cnt)) = Default_Character;
1752 Str (To) := Txt (size_t (Cnt));
1755 if Cnt < Str'Length then
1756 Str ((Str'First + Cnt) .. Str'Last) :=
1757 (others => (Ch => ' ',
1758 Color => Color_Pair'First,
1759 Attr => Normal_Video));
1764 (Win : Window := Standard_Window;
1765 Line : Line_Position;
1766 Column : Column_Position;
1767 Str : out Attributed_String;
1768 Len : Integer := -1)
1771 Move_Cursor (Win, Line, Column);
1772 Peek (Win, Str, Len);
1774 ------------------------------------------------------------------------------
1775 procedure Get (Win : Window := Standard_Window;
1777 Len : Integer := -1)
1779 function Wgetnstr (Win : Window;
1781 Len : C_Int) return C_Int;
1782 pragma Import (C, Wgetnstr, "wgetnstr");
1785 Txt : char_array (0 .. Str'Length);
1791 if N > Str'Length then
1792 raise Constraint_Error;
1794 Txt (0) := Interfaces.C.char'First;
1795 if Wgetnstr (Win, Txt, C_Int (N)) = Curses_Err then
1796 raise Curses_Exception;
1798 To_Ada (Txt, Str, Cnt, True);
1799 if Cnt < Str'Length then
1800 Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
1805 (Win : Window := Standard_Window;
1806 Line : Line_Position;
1807 Column : Column_Position;
1809 Len : Integer := -1)
1812 Move_Cursor (Win, Line, Column);
1813 Get (Win, Str, Len);
1815 ------------------------------------------------------------------------------
1816 procedure Init_Soft_Label_Keys
1817 (Format : Soft_Label_Key_Format := Three_Two_Three)
1819 function Slk_Init (Fmt : C_Int) return C_Int;
1820 pragma Import (C, Slk_Init, "slk_init");
1822 if Slk_Init (Soft_Label_Key_Format'Pos (Format)) = Curses_Err then
1823 raise Curses_Exception;
1825 end Init_Soft_Label_Keys;
1827 procedure Set_Soft_Label_Key (Label : Label_Number;
1829 Fmt : Label_Justification := Left)
1831 function Slk_Set (Label : C_Int;
1833 Fmt : C_Int) return C_Int;
1834 pragma Import (C, Slk_Set, "slk_set");
1836 Txt : char_array (0 .. Text'Length);
1839 To_C (Text, Txt, Len);
1840 if Slk_Set (C_Int (Label), Txt,
1841 C_Int (Label_Justification'Pos (Fmt))) = Curses_Err then
1842 raise Curses_Exception;
1844 end Set_Soft_Label_Key;
1846 procedure Refresh_Soft_Label_Keys
1848 function Slk_Refresh return C_Int;
1849 pragma Import (C, Slk_Refresh, "slk_refresh");
1851 if Slk_Refresh = Curses_Err then
1852 raise Curses_Exception;
1854 end Refresh_Soft_Label_Keys;
1856 procedure Refresh_Soft_Label_Keys_Without_Update
1858 function Slk_Noutrefresh return C_Int;
1859 pragma Import (C, Slk_Noutrefresh, "slk_noutrefresh");
1861 if Slk_Noutrefresh = Curses_Err then
1862 raise Curses_Exception;
1864 end Refresh_Soft_Label_Keys_Without_Update;
1866 procedure Get_Soft_Label_Key (Label : Label_Number;
1869 function Slk_Label (Label : C_Int) return chars_ptr;
1870 pragma Import (C, Slk_Label, "slk_label");
1872 Fill_String (Slk_Label (C_Int (Label)), Text);
1873 end Get_Soft_Label_Key;
1875 function Get_Soft_Label_Key (Label : Label_Number) return String
1877 function Slk_Label (Label : C_Int) return chars_ptr;
1878 pragma Import (C, Slk_Label, "slk_label");
1880 return Fill_String (Slk_Label (C_Int (Label)));
1881 end Get_Soft_Label_Key;
1883 procedure Clear_Soft_Label_Keys
1885 function Slk_Clear return C_Int;
1886 pragma Import (C, Slk_Clear, "slk_clear");
1888 if Slk_Clear = Curses_Err then
1889 raise Curses_Exception;
1891 end Clear_Soft_Label_Keys;
1893 procedure Restore_Soft_Label_Keys
1895 function Slk_Restore return C_Int;
1896 pragma Import (C, Slk_Restore, "slk_restore");
1898 if Slk_Restore = Curses_Err then
1899 raise Curses_Exception;
1901 end Restore_Soft_Label_Keys;
1903 procedure Touch_Soft_Label_Keys
1905 function Slk_Touch return C_Int;
1906 pragma Import (C, Slk_Touch, "slk_touch");
1908 if Slk_Touch = Curses_Err then
1909 raise Curses_Exception;
1911 end Touch_Soft_Label_Keys;
1913 procedure Switch_Soft_Label_Key_Attributes
1914 (Attr : Character_Attribute_Set;
1915 On : Boolean := True)
1917 function Slk_Attron (Ch : C_Chtype) return C_Int;
1918 pragma Import (C, Slk_Attron, "slk_attron");
1919 function Slk_Attroff (Ch : C_Chtype) return C_Int;
1920 pragma Import (C, Slk_Attroff, "slk_attroff");
1923 Ch : constant Attributed_Character := (Ch => Character'First,
1925 Color => Color_Pair'First);
1928 Err := Slk_Attron (AttrChar_To_Chtype (Ch));
1930 Err := Slk_Attroff (AttrChar_To_Chtype (Ch));
1932 if Err = Curses_Err then
1933 raise Curses_Exception;
1935 end Switch_Soft_Label_Key_Attributes;
1937 procedure Set_Soft_Label_Key_Attributes
1938 (Attr : Character_Attribute_Set := Normal_Video;
1939 Color : Color_Pair := Color_Pair'First)
1941 function Slk_Attrset (Ch : C_Chtype) return C_Int;
1942 pragma Import (C, Slk_Attrset, "slk_attrset");
1944 Ch : constant Attributed_Character := (Ch => Character'First,
1948 if Slk_Attrset (AttrChar_To_Chtype (Ch)) = Curses_Err then
1949 raise Curses_Exception;
1951 end Set_Soft_Label_Key_Attributes;
1953 function Get_Soft_Label_Key_Attributes return Character_Attribute_Set
1955 function Slk_Attr return C_Chtype;
1956 pragma Import (C, Slk_Attr, "slk_attr");
1958 Attr : constant C_Chtype := Slk_Attr;
1960 return Chtype_To_AttrChar (Attr).Attr;
1961 end Get_Soft_Label_Key_Attributes;
1963 function Get_Soft_Label_Key_Attributes return Color_Pair
1965 function Slk_Attr return C_Chtype;
1966 pragma Import (C, Slk_Attr, "slk_attr");
1968 Attr : constant C_Chtype := Slk_Attr;
1970 return Chtype_To_AttrChar (Attr).Color;
1971 end Get_Soft_Label_Key_Attributes;
1973 procedure Set_Soft_Label_Key_Color (Pair : Color_Pair)
1975 function Slk_Color (Color : C_Short) return C_Int;
1976 pragma Import (C, Slk_Color, "slk_color");
1978 if Slk_Color (C_Short (Pair)) = Curses_Err then
1979 raise Curses_Exception;
1981 end Set_Soft_Label_Key_Color;
1983 ------------------------------------------------------------------------------
1984 procedure Enable_Key (Key : Special_Key_Code;
1985 Enable : Boolean := True)
1987 function Keyok (Keycode : C_Int;
1988 On_Off : Curses_Bool) return C_Int;
1989 pragma Import (C, Keyok, "keyok");
1991 if Keyok (C_Int (Key), Curses_Bool (Boolean'Pos (Enable)))
1993 raise Curses_Exception;
1996 ------------------------------------------------------------------------------
1997 procedure Define_Key (Definition : String;
1998 Key : Special_Key_Code)
2000 function Defkey (Def : char_array;
2001 Key : C_Int) return C_Int;
2002 pragma Import (C, Defkey, "define_key");
2004 Txt : char_array (0 .. Definition'Length);
2007 To_C (Definition, Txt, Length);
2008 if Defkey (Txt, C_Int (Key)) = Curses_Err then
2009 raise Curses_Exception;
2012 ------------------------------------------------------------------------------
2013 procedure Un_Control (Ch : Attributed_Character;
2016 function Unctrl (Ch : C_Chtype) return chars_ptr;
2017 pragma Import (C, Unctrl, "unctrl");
2019 Fill_String (Unctrl (AttrChar_To_Chtype (Ch)), Str);
2022 function Un_Control (Ch : Attributed_Character) return String
2024 function Unctrl (Ch : C_Chtype) return chars_ptr;
2025 pragma Import (C, Unctrl, "unctrl");
2027 return Fill_String (Unctrl (AttrChar_To_Chtype (Ch)));
2030 procedure Delay_Output (Msecs : Natural)
2032 function Delayoutput (Msecs : C_Int) return C_Int;
2033 pragma Import (C, Delayoutput, "delay_output");
2035 if Delayoutput (C_Int (Msecs)) = Curses_Err then
2036 raise Curses_Exception;
2040 procedure Flush_Input
2042 function Flushinp return C_Int;
2043 pragma Import (C, Flushinp, "flushinp");
2045 if Flushinp = Curses_Err then -- docu says that never happens, but...
2046 raise Curses_Exception;
2049 ------------------------------------------------------------------------------
2050 function Baudrate return Natural
2052 function Baud return C_Int;
2053 pragma Import (C, Baud, "baudrate");
2055 return Natural (Baud);
2058 function Erase_Character return Character
2060 function Erasechar return C_Int;
2061 pragma Import (C, Erasechar, "erasechar");
2063 return Character'Val (Erasechar);
2064 end Erase_Character;
2066 function Kill_Character return Character
2068 function Killchar return C_Int;
2069 pragma Import (C, Killchar, "killchar");
2071 return Character'Val (Killchar);
2074 function Has_Insert_Character return Boolean
2076 function Has_Ic return Curses_Bool;
2077 pragma Import (C, Has_Ic, "has_ic");
2079 if Has_Ic = Curses_Bool_False then
2084 end Has_Insert_Character;
2086 function Has_Insert_Line return Boolean
2088 function Has_Il return Curses_Bool;
2089 pragma Import (C, Has_Il, "has_il");
2091 if Has_Il = Curses_Bool_False then
2096 end Has_Insert_Line;
2098 function Supported_Attributes return Character_Attribute_Set
2100 function Termattrs return C_Chtype;
2101 pragma Import (C, Termattrs, "termattrs");
2103 Ch : constant Attributed_Character := Chtype_To_AttrChar (Termattrs);
2106 end Supported_Attributes;
2108 procedure Long_Name (Name : out String)
2110 function Longname return chars_ptr;
2111 pragma Import (C, Longname, "longname");
2113 Fill_String (Longname, Name);
2116 function Long_Name return String
2118 function Longname return chars_ptr;
2119 pragma Import (C, Longname, "longname");
2121 return Fill_String (Longname);
2124 procedure Terminal_Name (Name : out String)
2126 function Termname return chars_ptr;
2127 pragma Import (C, Termname, "termname");
2129 Fill_String (Termname, Name);
2132 function Terminal_Name return String
2134 function Termname return chars_ptr;
2135 pragma Import (C, Termname, "termname");
2137 return Fill_String (Termname);
2139 ------------------------------------------------------------------------------
2140 procedure Init_Pair (Pair : Redefinable_Color_Pair;
2141 Fore : Color_Number;
2142 Back : Color_Number)
2144 function Initpair (Pair : C_Short;
2146 Back : C_Short) return C_Int;
2147 pragma Import (C, Initpair, "init_pair");
2149 if Integer (Pair) >= Number_Of_Color_Pairs then
2150 raise Constraint_Error;
2152 if Integer (Fore) >= Number_Of_Colors or else
2153 Integer (Back) >= Number_Of_Colors then
2154 raise Constraint_Error;
2156 if Initpair (C_Short (Pair), C_Short (Fore), C_Short (Back))
2158 raise Curses_Exception;
2162 procedure Pair_Content (Pair : Color_Pair;
2163 Fore : out Color_Number;
2164 Back : out Color_Number)
2166 type C_Short_Access is access all C_Short;
2167 function Paircontent (Pair : C_Short;
2168 Fp : C_Short_Access;
2169 Bp : C_Short_Access) return C_Int;
2170 pragma Import (C, Paircontent, "pair_content");
2172 F, B : aliased C_Short;
2174 if Paircontent (C_Short (Pair), F'Access, B'Access) = Curses_Err then
2175 raise Curses_Exception;
2177 Fore := Color_Number (F);
2178 Back := Color_Number (B);
2182 function Has_Colors return Boolean
2184 function Hascolors return Curses_Bool;
2185 pragma Import (C, Hascolors, "has_colors");
2187 if Hascolors = Curses_Bool_False then
2194 procedure Init_Color (Color : Color_Number;
2199 function Initcolor (Col : C_Short;
2202 Blue : C_Short) return C_Int;
2203 pragma Import (C, Initcolor, "init_color");
2205 if Initcolor (C_Short (Color), C_Short (Red), C_Short (Green),
2206 C_Short (Blue)) = Curses_Err then
2207 raise Curses_Exception;
2211 function Can_Change_Color return Boolean
2213 function Canchangecolor return Curses_Bool;
2214 pragma Import (C, Canchangecolor, "can_change_color");
2216 if Canchangecolor = Curses_Bool_False then
2221 end Can_Change_Color;
2223 procedure Color_Content (Color : Color_Number;
2224 Red : out RGB_Value;
2225 Green : out RGB_Value;
2226 Blue : out RGB_Value)
2228 type C_Short_Access is access all C_Short;
2230 function Colorcontent (Color : C_Short; R, G, B : C_Short_Access)
2232 pragma Import (C, Colorcontent, "color_content");
2234 R, G, B : aliased C_Short;
2236 if Colorcontent (C_Short (Color), R'Access, G'Access, B'Access) =
2238 raise Curses_Exception;
2240 Red := RGB_Value (R);
2241 Green := RGB_Value (G);
2242 Blue := RGB_Value (B);
2246 ------------------------------------------------------------------------------
2247 procedure Save_Curses_Mode (Mode : Curses_Mode)
2249 function Def_Prog_Mode return C_Int;
2250 pragma Import (C, Def_Prog_Mode, "def_prog_mode");
2251 function Def_Shell_Mode return C_Int;
2252 pragma Import (C, Def_Shell_Mode, "def_shell_mode");
2257 when Curses => Err := Def_Prog_Mode;
2258 when Shell => Err := Def_Shell_Mode;
2260 if Err = Curses_Err then
2261 raise Curses_Exception;
2263 end Save_Curses_Mode;
2265 procedure Reset_Curses_Mode (Mode : Curses_Mode)
2267 function Reset_Prog_Mode return C_Int;
2268 pragma Import (C, Reset_Prog_Mode, "reset_prog_mode");
2269 function Reset_Shell_Mode return C_Int;
2270 pragma Import (C, Reset_Shell_Mode, "reset_shell_mode");
2275 when Curses => Err := Reset_Prog_Mode;
2276 when Shell => Err := Reset_Shell_Mode;
2278 if Err = Curses_Err then
2279 raise Curses_Exception;
2281 end Reset_Curses_Mode;
2283 procedure Save_Terminal_State
2285 function Savetty return C_Int;
2286 pragma Import (C, Savetty, "savetty");
2288 if Savetty = Curses_Err then
2289 raise Curses_Exception;
2291 end Save_Terminal_State;
2293 procedure Reset_Terminal_State
2295 function Resetty return C_Int;
2296 pragma Import (C, Resetty, "resetty");
2298 if Resetty = Curses_Err then
2299 raise Curses_Exception;
2301 end Reset_Terminal_State;
2303 procedure Rip_Off_Lines (Lines : Integer;
2304 Proc : Stdscr_Init_Proc)
2306 function Ripoffline (Lines : C_Int;
2307 Proc : Stdscr_Init_Proc) return C_Int;
2308 pragma Import (C, Ripoffline, "_nc_ripoffline");
2310 if Ripoffline (C_Int (Lines), Proc) = Curses_Err then
2311 raise Curses_Exception;
2315 procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility)
2317 function Curs_Set (Curs : C_Int) return C_Int;
2318 pragma Import (C, Curs_Set, "curs_set");
2322 Res := Curs_Set (Cursor_Visibility'Pos (Visibility));
2323 if Res /= Curses_Err then
2324 Visibility := Cursor_Visibility'Val (Res);
2326 end Set_Cursor_Visibility;
2328 procedure Nap_Milli_Seconds (Ms : Natural)
2330 function Napms (Ms : C_Int) return C_Int;
2331 pragma Import (C, Napms, "napms");
2333 if Napms (C_Int (Ms)) = Curses_Err then
2334 raise Curses_Exception;
2336 end Nap_Milli_Seconds;
2337 ------------------------------------------------------------------------------
2338 include(`Public_Variables')
2339 ------------------------------------------------------------------------------
2340 procedure Transform_Coordinates
2341 (W : Window := Standard_Window;
2342 Line : in out Line_Position;
2343 Column : in out Column_Position;
2344 Dir : Transform_Direction := From_Screen)
2346 type Int_Access is access all C_Int;
2347 function Transform (W : Window;
2349 Dir : Curses_Bool) return C_Int;
2350 pragma Import (C, Transform, "wmouse_trafo");
2352 X : aliased C_Int := C_Int (Column);
2353 Y : aliased C_Int := C_Int (Line);
2354 D : Curses_Bool := Curses_Bool_False;
2357 if Dir = To_Screen then
2360 R := Transform (W, Y'Access, X'Access, D);
2361 if R = Curses_False then
2362 raise Curses_Exception;
2364 Line := Line_Position (Y);
2365 Column := Column_Position (X);
2367 end Transform_Coordinates;
2368 ------------------------------------------------------------------------------
2369 procedure Use_Default_Colors is
2370 function C_Use_Default_Colors return C_Int;
2371 pragma Import (C, C_Use_Default_Colors, "use_default_colors");
2372 Err : constant C_Int := C_Use_Default_Colors;
2374 if Err = Curses_Err then
2375 raise Curses_Exception;
2377 end Use_Default_Colors;
2379 procedure Assume_Default_Colors (Fore : Color_Number := Default_Color;
2380 Back : Color_Number := Default_Color)
2382 function C_Assume_Default_Colors (Fore : C_Int;
2383 Back : C_Int) return C_Int;
2384 pragma Import (C, C_Assume_Default_Colors, "assume_default_colors");
2386 Err : constant C_Int := C_Assume_Default_Colors (C_Int (Fore),
2389 if Err = Curses_Err then
2390 raise Curses_Exception;
2392 end Assume_Default_Colors;
2393 ------------------------------------------------------------------------------
2394 function Curses_Version return String
2396 function curses_versionC return chars_ptr;
2397 pragma Import (C, curses_versionC, "curses_version");
2398 Result : constant chars_ptr := curses_versionC;
2400 return Fill_String (Result);
2402 ------------------------------------------------------------------------------
2403 procedure Curses_Free_All is
2404 procedure curses_freeall;
2405 pragma Import (C, curses_freeall, "_nc_freeall");
2407 -- Use this only for testing: you cannot use curses after calling it,
2408 -- so it has to be the "last" thing done before exiting the program.
2409 -- This will not really free ALL of memory used by curses. That is
2410 -- because it cannot free the memory used for stdout's setbuf. The
2411 -- _nc_free_and_exit() procedure can do that, but it can be invoked
2412 -- safely only from C - and again, that only as the "last" thing done
2413 -- before exiting the program.
2415 end Curses_Free_All;
2416 ------------------------------------------------------------------------------
2417 function Use_Extended_Names (Enable : Boolean) return Boolean
2419 function use_extended_namesC (e : Curses_Bool) return C_Int;
2420 pragma Import (C, use_extended_namesC, "use_extended_names");
2422 Res : constant C_Int :=
2423 use_extended_namesC (Curses_Bool (Boolean'Pos (Enable)));
2425 if Res = C_Int (Curses_Bool_False) then
2430 end Use_Extended_Names;
2431 ------------------------------------------------------------------------------
2432 procedure Screen_Dump_To_File (Filename : String)
2434 function scr_dump (f : char_array) return C_Int;
2435 pragma Import (C, scr_dump, "scr_dump");
2436 Txt : char_array (0 .. Filename'Length);
2439 To_C (Filename, Txt, Length);
2440 if Curses_Err = scr_dump (Txt) then
2441 raise Curses_Exception;
2443 end Screen_Dump_To_File;
2445 procedure Screen_Restore_From_File (Filename : String)
2447 function scr_restore (f : char_array) return C_Int;
2448 pragma Import (C, scr_restore, "scr_restore");
2449 Txt : char_array (0 .. Filename'Length);
2452 To_C (Filename, Txt, Length);
2453 if Curses_Err = scr_restore (Txt) then
2454 raise Curses_Exception;
2456 end Screen_Restore_From_File;
2458 procedure Screen_Init_From_File (Filename : String)
2460 function scr_init (f : char_array) return C_Int;
2461 pragma Import (C, scr_init, "scr_init");
2462 Txt : char_array (0 .. Filename'Length);
2465 To_C (Filename, Txt, Length);
2466 if Curses_Err = scr_init (Txt) then
2467 raise Curses_Exception;
2469 end Screen_Init_From_File;
2471 procedure Screen_Set_File (Filename : String)
2473 function scr_set (f : char_array) return C_Int;
2474 pragma Import (C, scr_set, "scr_set");
2475 Txt : char_array (0 .. Filename'Length);
2478 To_C (Filename, Txt, Length);
2479 if Curses_Err = scr_set (Txt) then
2480 raise Curses_Exception;
2482 end Screen_Set_File;
2483 ------------------------------------------------------------------------------
2484 procedure Resize (Win : Window := Standard_Window;
2485 Number_Of_Lines : Line_Count;
2486 Number_Of_Columns : Column_Count) is
2487 function wresize (win : Window;
2489 columns : C_Int) return C_Int;
2490 pragma Import (C, wresize);
2493 C_Int (Number_Of_Lines),
2494 C_Int (Number_Of_Columns)) = Curses_Err then
2495 raise Curses_Exception;
2498 ------------------------------------------------------------------------------
2500 end Terminal_Interface.Curses;