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-2011,2014 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: 2014/05/24 21:31:05 $
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 : Attributed_Character) return C_Int;
155 pragma Import (C, Waddch, "waddch");
157 if Waddch (Win, 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 : Attributed_Character) return C_Int;
182 pragma Import (C, mvwaddch, "mvwaddch");
184 if mvwaddch (Win, C_Int (Line),
188 raise Curses_Exception;
193 (Win : Window := Standard_Window;
194 Line : Line_Position;
195 Column : Column_Position;
202 Attributed_Character'(Ch => Ch,
203 Color => Color_Pair'First,
204 Attr => Normal_Video));
207 procedure Add_With_Immediate_Echo
208 (Win : Window := Standard_Window;
209 Ch : Attributed_Character)
211 function Wechochar (W : Window;
212 Ch : Attributed_Character) return C_Int;
213 pragma Import (C, Wechochar, "wechochar");
215 if Wechochar (Win, Ch) = Curses_Err then
216 raise Curses_Exception;
218 end Add_With_Immediate_Echo;
220 procedure Add_With_Immediate_Echo
221 (Win : Window := Standard_Window;
225 Add_With_Immediate_Echo
227 Attributed_Character'(Ch => Ch,
228 Color => Color_Pair'First,
229 Attr => Normal_Video));
230 end Add_With_Immediate_Echo;
231 ------------------------------------------------------------------------------
232 function Create (Number_Of_Lines : Line_Count;
233 Number_Of_Columns : Column_Count;
234 First_Line_Position : Line_Position;
235 First_Column_Position : Column_Position) return Window
237 function Newwin (Number_Of_Lines : C_Int;
238 Number_Of_Columns : C_Int;
239 First_Line_Position : C_Int;
240 First_Column_Position : C_Int) return Window;
241 pragma Import (C, Newwin, "newwin");
245 W := Newwin (C_Int (Number_Of_Lines),
246 C_Int (Number_Of_Columns),
247 C_Int (First_Line_Position),
248 C_Int (First_Column_Position));
249 if W = Null_Window then
250 raise Curses_Exception;
255 procedure Delete (Win : in out Window)
257 function Wdelwin (W : Window) return C_Int;
258 pragma Import (C, Wdelwin, "delwin");
260 if Wdelwin (Win) = Curses_Err then
261 raise Curses_Exception;
267 (Win : Window := Standard_Window;
268 Number_Of_Lines : Line_Count;
269 Number_Of_Columns : Column_Count;
270 First_Line_Position : Line_Position;
271 First_Column_Position : Column_Position) return Window
275 Number_Of_Lines : C_Int;
276 Number_Of_Columns : C_Int;
277 First_Line_Position : C_Int;
278 First_Column_Position : C_Int) return Window;
279 pragma Import (C, Subwin, "subwin");
284 C_Int (Number_Of_Lines),
285 C_Int (Number_Of_Columns),
286 C_Int (First_Line_Position),
287 C_Int (First_Column_Position));
288 if W = Null_Window then
289 raise Curses_Exception;
294 function Derived_Window
295 (Win : Window := Standard_Window;
296 Number_Of_Lines : Line_Count;
297 Number_Of_Columns : Column_Count;
298 First_Line_Position : Line_Position;
299 First_Column_Position : Column_Position) return Window
303 Number_Of_Lines : C_Int;
304 Number_Of_Columns : C_Int;
305 First_Line_Position : C_Int;
306 First_Column_Position : C_Int) return Window;
307 pragma Import (C, Derwin, "derwin");
312 C_Int (Number_Of_Lines),
313 C_Int (Number_Of_Columns),
314 C_Int (First_Line_Position),
315 C_Int (First_Column_Position));
316 if W = Null_Window then
317 raise Curses_Exception;
322 function Duplicate (Win : Window) return Window
324 function Dupwin (Win : Window) return Window;
325 pragma Import (C, Dupwin, "dupwin");
327 W : constant Window := Dupwin (Win);
329 if W = Null_Window then
330 raise Curses_Exception;
335 procedure Move_Window (Win : Window;
336 Line : Line_Position;
337 Column : Column_Position)
339 function Mvwin (Win : Window;
341 Column : C_Int) return C_Int;
342 pragma Import (C, Mvwin, "mvwin");
344 if Mvwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
345 raise Curses_Exception;
349 procedure Move_Derived_Window (Win : Window;
350 Line : Line_Position;
351 Column : Column_Position)
353 function Mvderwin (Win : Window;
355 Column : C_Int) return C_Int;
356 pragma Import (C, Mvderwin, "mvderwin");
358 if Mvderwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
359 raise Curses_Exception;
361 end Move_Derived_Window;
363 procedure Set_Synch_Mode (Win : Window := Standard_Window;
364 Mode : Boolean := False)
366 function Syncok (Win : Window;
367 Mode : Curses_Bool) return C_Int;
368 pragma Import (C, Syncok, "syncok");
370 if Syncok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
371 raise Curses_Exception;
374 ------------------------------------------------------------------------------
375 procedure Add (Win : Window := Standard_Window;
379 function Waddnstr (Win : Window;
381 Len : C_Int := -1) return C_Int;
382 pragma Import (C, Waddnstr, "waddnstr");
384 Txt : char_array (0 .. Str'Length);
387 To_C (Str, Txt, Length);
388 if Waddnstr (Win, Txt, C_Int (Len)) = Curses_Err then
389 raise Curses_Exception;
394 (Win : Window := Standard_Window;
395 Line : Line_Position;
396 Column : Column_Position;
401 Move_Cursor (Win, Line, Column);
404 ------------------------------------------------------------------------------
406 (Win : Window := Standard_Window;
407 Str : Attributed_String;
410 function Waddchnstr (Win : Window;
412 Len : C_Int := -1) return C_Int;
413 pragma Import (C, Waddchnstr, "waddchnstr");
415 Txt : chtype_array (0 .. Str'Length);
417 for Length in 1 .. size_t (Str'Length) loop
418 Txt (Length - 1) := Str (Natural (Length));
420 Txt (Str'Length) := Default_Character;
423 C_Int (Len)) = Curses_Err
425 raise Curses_Exception;
430 (Win : Window := Standard_Window;
431 Line : Line_Position;
432 Column : Column_Position;
433 Str : Attributed_String;
437 Move_Cursor (Win, Line, Column);
440 ------------------------------------------------------------------------------
442 (Win : Window := Standard_Window;
443 Left_Side_Symbol : Attributed_Character := Default_Character;
444 Right_Side_Symbol : Attributed_Character := Default_Character;
445 Top_Side_Symbol : Attributed_Character := Default_Character;
446 Bottom_Side_Symbol : Attributed_Character := Default_Character;
447 Upper_Left_Corner_Symbol : Attributed_Character := Default_Character;
448 Upper_Right_Corner_Symbol : Attributed_Character := Default_Character;
449 Lower_Left_Corner_Symbol : Attributed_Character := Default_Character;
450 Lower_Right_Corner_Symbol : Attributed_Character := Default_Character)
452 function Wborder (W : Window;
453 LS : Attributed_Character;
454 RS : Attributed_Character;
455 TS : Attributed_Character;
456 BS : Attributed_Character;
457 ULC : Attributed_Character;
458 URC : Attributed_Character;
459 LLC : Attributed_Character;
460 LRC : Attributed_Character) return C_Int;
461 pragma Import (C, Wborder, "wborder");
468 Upper_Left_Corner_Symbol,
469 Upper_Right_Corner_Symbol,
470 Lower_Left_Corner_Symbol,
471 Lower_Right_Corner_Symbol) = Curses_Err
473 raise Curses_Exception;
478 (Win : Window := Standard_Window;
479 Vertical_Symbol : Attributed_Character := Default_Character;
480 Horizontal_Symbol : Attributed_Character := Default_Character)
484 Vertical_Symbol, Vertical_Symbol,
485 Horizontal_Symbol, Horizontal_Symbol);
488 procedure Horizontal_Line
489 (Win : Window := Standard_Window;
491 Line_Symbol : Attributed_Character := Default_Character)
493 function Whline (W : Window;
494 Ch : Attributed_Character;
495 Len : C_Int) return C_Int;
496 pragma Import (C, Whline, "whline");
500 C_Int (Line_Size)) = Curses_Err
502 raise Curses_Exception;
506 procedure Vertical_Line
507 (Win : Window := Standard_Window;
509 Line_Symbol : Attributed_Character := Default_Character)
511 function Wvline (W : Window;
512 Ch : Attributed_Character;
513 Len : C_Int) return C_Int;
514 pragma Import (C, Wvline, "wvline");
518 C_Int (Line_Size)) = Curses_Err
520 raise Curses_Exception;
524 ------------------------------------------------------------------------------
525 function Get_Keystroke (Win : Window := Standard_Window)
528 function Wgetch (W : Window) return C_Int;
529 pragma Import (C, Wgetch, "wgetch");
531 C : constant C_Int := Wgetch (Win);
533 if C = Curses_Err then
536 return Real_Key_Code (C);
540 procedure Undo_Keystroke (Key : Real_Key_Code)
542 function Ungetch (Ch : C_Int) return C_Int;
543 pragma Import (C, Ungetch, "ungetch");
545 if Ungetch (C_Int (Key)) = Curses_Err then
546 raise Curses_Exception;
550 function Has_Key (Key : Special_Key_Code) return Boolean
552 function Haskey (Key : C_Int) return C_Int;
553 pragma Import (C, Haskey, "has_key");
555 if Haskey (C_Int (Key)) = Curses_False then
562 function Is_Function_Key (Key : Special_Key_Code) return Boolean
564 L : constant Special_Key_Code := Special_Key_Code (Natural (Key_F0) +
565 Natural (Function_Key_Number'Last));
567 if (Key >= Key_F0) and then (Key <= L) then
574 function Function_Key (Key : Real_Key_Code)
575 return Function_Key_Number
578 if Is_Function_Key (Key) then
579 return Function_Key_Number (Key - Key_F0);
581 raise Constraint_Error;
585 function Function_Key_Code (Key : Function_Key_Number) return Real_Key_Code
588 return Real_Key_Code (Natural (Key_F0) + Natural (Key));
589 end Function_Key_Code;
590 ------------------------------------------------------------------------------
591 procedure Standout (Win : Window := Standard_Window;
592 On : Boolean := True)
594 function wstandout (Win : Window) return C_Int;
595 pragma Import (C, wstandout, "wstandout");
596 function wstandend (Win : Window) return C_Int;
597 pragma Import (C, wstandend, "wstandend");
602 Err := wstandout (Win);
604 Err := wstandend (Win);
606 if Err = Curses_Err then
607 raise Curses_Exception;
611 procedure Switch_Character_Attribute
612 (Win : Window := Standard_Window;
613 Attr : Character_Attribute_Set := Normal_Video;
614 On : Boolean := True)
616 function Wattron (Win : Window;
617 C_Attr : Attributed_Character) return C_Int;
618 pragma Import (C, Wattron, "wattr_on");
619 function Wattroff (Win : Window;
620 C_Attr : Attributed_Character) return C_Int;
621 pragma Import (C, Wattroff, "wattr_off");
622 -- In Ada we use the On Boolean to control whether or not we want to
623 -- switch on or off the attributes in the set.
625 AC : constant Attributed_Character := (Ch => Character'First,
626 Color => Color_Pair'First,
630 Err := Wattron (Win, AC);
632 Err := Wattroff (Win, AC);
634 if Err = Curses_Err then
635 raise Curses_Exception;
637 end Switch_Character_Attribute;
639 procedure Set_Character_Attributes
640 (Win : Window := Standard_Window;
641 Attr : Character_Attribute_Set := Normal_Video;
642 Color : Color_Pair := Color_Pair'First)
644 function Wattrset (Win : Window;
645 C_Attr : Attributed_Character) return C_Int;
646 pragma Import (C, Wattrset, "wattrset"); -- ??? wattr_set
648 if Wattrset (Win, (Ch => Character'First,
650 Attr => Attr)) = Curses_Err
652 raise Curses_Exception;
654 end Set_Character_Attributes;
656 function Get_Character_Attribute (Win : Window := Standard_Window)
657 return Character_Attribute_Set
659 function Wattrget (Win : Window;
660 Atr : access Attributed_Character;
661 Col : access C_Short;
662 Opt : System.Address) return C_Int;
663 pragma Import (C, Wattrget, "wattr_get");
665 Attr : aliased Attributed_Character;
666 Col : aliased C_Short;
667 Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
668 System.Null_Address);
670 if Res = Curses_Ok then
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 Attributed_Character;
682 Col : access C_Short;
683 Opt : System.Address) return C_Int;
684 pragma Import (C, Wattrget, "wattr_get");
686 Attr : aliased Attributed_Character;
687 Col : aliased C_Short;
688 Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
689 System.Null_Address);
691 if Res = Curses_Ok then
694 raise Curses_Exception;
696 end Get_Character_Attribute;
698 procedure Set_Color (Win : Window := Standard_Window;
701 function Wset_Color (Win : Window;
703 Opts : C_Void_Ptr) return C_Int;
704 pragma Import (C, Wset_Color, "wcolor_set");
708 C_Void_Ptr (System.Null_Address)) = Curses_Err
710 raise Curses_Exception;
714 procedure Change_Attributes
715 (Win : Window := Standard_Window;
716 Count : Integer := -1;
717 Attr : Character_Attribute_Set := Normal_Video;
718 Color : Color_Pair := Color_Pair'First)
720 function Wchgat (Win : Window;
722 Attr : Attributed_Character;
724 Opts : System.Address := System.Null_Address)
726 pragma Import (C, Wchgat, "wchgat");
730 (Ch => Character'First,
731 Color => Color_Pair'First,
733 C_Short (Color)) = Curses_Err
735 raise Curses_Exception;
737 end Change_Attributes;
739 procedure Change_Attributes
740 (Win : Window := Standard_Window;
741 Line : Line_Position := Line_Position'First;
742 Column : Column_Position := Column_Position'First;
743 Count : Integer := -1;
744 Attr : Character_Attribute_Set := Normal_Video;
745 Color : Color_Pair := Color_Pair'First)
748 Move_Cursor (Win, Line, Column);
749 Change_Attributes (Win, Count, Attr, Color);
750 end Change_Attributes;
751 ------------------------------------------------------------------------------
754 function Beeper return C_Int;
755 pragma Import (C, Beeper, "beep");
757 if Beeper = Curses_Err then
758 raise Curses_Exception;
762 procedure Flash_Screen
764 function Flash return C_Int;
765 pragma Import (C, Flash, "flash");
767 if Flash = Curses_Err then
768 raise Curses_Exception;
771 ------------------------------------------------------------------------------
772 procedure Set_Cbreak_Mode (SwitchOn : Boolean := True)
774 function Cbreak return C_Int;
775 pragma Import (C, Cbreak, "cbreak");
776 function NoCbreak return C_Int;
777 pragma Import (C, NoCbreak, "nocbreak");
786 if Err = Curses_Err then
787 raise Curses_Exception;
791 procedure Set_Raw_Mode (SwitchOn : Boolean := True)
793 function Raw return C_Int;
794 pragma Import (C, Raw, "raw");
795 function NoRaw return C_Int;
796 pragma Import (C, NoRaw, "noraw");
805 if Err = Curses_Err then
806 raise Curses_Exception;
810 procedure Set_Echo_Mode (SwitchOn : Boolean := True)
812 function Echo return C_Int;
813 pragma Import (C, Echo, "echo");
814 function NoEcho return C_Int;
815 pragma Import (C, NoEcho, "noecho");
824 if Err = Curses_Err then
825 raise Curses_Exception;
829 procedure Set_Meta_Mode (Win : Window := Standard_Window;
830 SwitchOn : Boolean := True)
832 function Meta (W : Window; Mode : Curses_Bool) return C_Int;
833 pragma Import (C, Meta, "meta");
835 if Meta (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then
836 raise Curses_Exception;
840 procedure Set_KeyPad_Mode (Win : Window := Standard_Window;
841 SwitchOn : Boolean := True)
843 function Keypad (W : Window; Mode : Curses_Bool) return C_Int;
844 pragma Import (C, Keypad, "keypad");
846 if Keypad (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then
847 raise Curses_Exception;
851 function Get_KeyPad_Mode (Win : Window := Standard_Window)
854 function Is_Keypad (W : Window) return Curses_Bool;
855 pragma Import (C, Is_Keypad, "is_keypad");
857 return (Is_Keypad (Win) /= Curses_Bool_False);
860 procedure Half_Delay (Amount : Half_Delay_Amount)
862 function Halfdelay (Amount : C_Int) return C_Int;
863 pragma Import (C, Halfdelay, "halfdelay");
865 if Halfdelay (C_Int (Amount)) = Curses_Err then
866 raise Curses_Exception;
870 procedure Set_Flush_On_Interrupt_Mode
871 (Win : Window := Standard_Window;
872 Mode : Boolean := True)
874 function Intrflush (Win : Window; Mode : Curses_Bool) return C_Int;
875 pragma Import (C, Intrflush, "intrflush");
877 if Intrflush (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
878 raise Curses_Exception;
880 end Set_Flush_On_Interrupt_Mode;
882 procedure Set_Queue_Interrupt_Mode
883 (Win : Window := Standard_Window;
884 Flush : Boolean := True)
887 pragma Import (C, Qiflush, "qiflush");
888 procedure No_Qiflush;
889 pragma Import (C, No_Qiflush, "noqiflush");
891 if Win = Null_Window then
892 raise Curses_Exception;
899 end Set_Queue_Interrupt_Mode;
901 procedure Set_NoDelay_Mode
902 (Win : Window := Standard_Window;
903 Mode : Boolean := False)
905 function Nodelay (Win : Window; Mode : Curses_Bool) return C_Int;
906 pragma Import (C, Nodelay, "nodelay");
908 if Nodelay (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
909 raise Curses_Exception;
911 end Set_NoDelay_Mode;
913 procedure Set_Timeout_Mode (Win : Window := Standard_Window;
917 procedure Wtimeout (Win : Window; Amount : C_Int);
918 pragma Import (C, Wtimeout, "wtimeout");
923 when Blocking => Time := -1;
924 when Non_Blocking => Time := 0;
927 raise Constraint_Error;
929 Time := C_Int (Amount);
931 Wtimeout (Win, Time);
932 end Set_Timeout_Mode;
934 procedure Set_Escape_Timer_Mode
935 (Win : Window := Standard_Window;
936 Timer_Off : Boolean := False)
938 function Notimeout (Win : Window; Mode : Curses_Bool) return C_Int;
939 pragma Import (C, Notimeout, "notimeout");
941 if Notimeout (Win, Curses_Bool (Boolean'Pos (Timer_Off)))
944 raise Curses_Exception;
946 end Set_Escape_Timer_Mode;
948 ------------------------------------------------------------------------------
949 procedure Set_NL_Mode (SwitchOn : Boolean := True)
951 function NL return C_Int;
952 pragma Import (C, NL, "nl");
953 function NoNL return C_Int;
954 pragma Import (C, NoNL, "nonl");
963 if Err = Curses_Err then
964 raise Curses_Exception;
968 procedure Clear_On_Next_Update
969 (Win : Window := Standard_Window;
970 Do_Clear : Boolean := True)
972 function Clear_Ok (W : Window; Flag : Curses_Bool) return C_Int;
973 pragma Import (C, Clear_Ok, "clearok");
975 if Clear_Ok (Win, Curses_Bool (Boolean'Pos (Do_Clear))) = Curses_Err then
976 raise Curses_Exception;
978 end Clear_On_Next_Update;
980 procedure Use_Insert_Delete_Line
981 (Win : Window := Standard_Window;
982 Do_Idl : Boolean := True)
984 function IDL_Ok (W : Window; Flag : Curses_Bool) return C_Int;
985 pragma Import (C, IDL_Ok, "idlok");
987 if IDL_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idl))) = Curses_Err then
988 raise Curses_Exception;
990 end Use_Insert_Delete_Line;
992 procedure Use_Insert_Delete_Character
993 (Win : Window := Standard_Window;
994 Do_Idc : Boolean := True)
996 procedure IDC_Ok (W : Window; Flag : Curses_Bool);
997 pragma Import (C, IDC_Ok, "idcok");
999 IDC_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idc)));
1000 end Use_Insert_Delete_Character;
1002 procedure Leave_Cursor_After_Update
1003 (Win : Window := Standard_Window;
1004 Do_Leave : Boolean := True)
1006 function Leave_Ok (W : Window; Flag : Curses_Bool) return C_Int;
1007 pragma Import (C, Leave_Ok, "leaveok");
1009 if Leave_Ok (Win, Curses_Bool (Boolean'Pos (Do_Leave))) = Curses_Err then
1010 raise Curses_Exception;
1012 end Leave_Cursor_After_Update;
1014 procedure Immediate_Update_Mode
1015 (Win : Window := Standard_Window;
1016 Mode : Boolean := False)
1018 procedure Immedok (Win : Window; Mode : Curses_Bool);
1019 pragma Import (C, Immedok, "immedok");
1021 Immedok (Win, Curses_Bool (Boolean'Pos (Mode)));
1022 end Immediate_Update_Mode;
1024 procedure Allow_Scrolling
1025 (Win : Window := Standard_Window;
1026 Mode : Boolean := False)
1028 function Scrollok (Win : Window; Mode : Curses_Bool) return C_Int;
1029 pragma Import (C, Scrollok, "scrollok");
1031 if Scrollok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
1032 raise Curses_Exception;
1034 end Allow_Scrolling;
1036 function Scrolling_Allowed (Win : Window := Standard_Window)
1039 function Is_Scroll_Ok (W : Window) return Curses_Bool;
1040 pragma Import (C, Is_Scroll_Ok, "is_scrollok");
1042 return (Is_Scroll_Ok (Win) /= Curses_Bool_False);
1043 end Scrolling_Allowed;
1045 procedure Set_Scroll_Region
1046 (Win : Window := Standard_Window;
1047 Top_Line : Line_Position;
1048 Bottom_Line : Line_Position)
1050 function Wsetscrreg (Win : Window;
1052 Col : C_Int) return C_Int;
1053 pragma Import (C, Wsetscrreg, "wsetscrreg");
1055 if Wsetscrreg (Win, C_Int (Top_Line), C_Int (Bottom_Line))
1058 raise Curses_Exception;
1060 end Set_Scroll_Region;
1061 ------------------------------------------------------------------------------
1062 procedure Update_Screen
1064 function Do_Update return C_Int;
1065 pragma Import (C, Do_Update, "doupdate");
1067 if Do_Update = Curses_Err then
1068 raise Curses_Exception;
1072 procedure Refresh (Win : Window := Standard_Window)
1074 function Wrefresh (W : Window) return C_Int;
1075 pragma Import (C, Wrefresh, "wrefresh");
1077 if Wrefresh (Win) = Curses_Err then
1078 raise Curses_Exception;
1082 procedure Refresh_Without_Update
1083 (Win : Window := Standard_Window)
1085 function Wnoutrefresh (W : Window) return C_Int;
1086 pragma Import (C, Wnoutrefresh, "wnoutrefresh");
1088 if Wnoutrefresh (Win) = Curses_Err then
1089 raise Curses_Exception;
1091 end Refresh_Without_Update;
1093 procedure Redraw (Win : Window := Standard_Window)
1095 function Redrawwin (Win : Window) return C_Int;
1096 pragma Import (C, Redrawwin, "redrawwin");
1098 if Redrawwin (Win) = Curses_Err then
1099 raise Curses_Exception;
1104 (Win : Window := Standard_Window;
1105 Begin_Line : Line_Position;
1106 Line_Count : Positive)
1108 function Wredrawln (Win : Window; First : C_Int; Cnt : C_Int)
1110 pragma Import (C, Wredrawln, "wredrawln");
1114 C_Int (Line_Count)) = Curses_Err
1116 raise Curses_Exception;
1120 ------------------------------------------------------------------------------
1121 procedure Erase (Win : Window := Standard_Window)
1123 function Werase (W : Window) return C_Int;
1124 pragma Import (C, Werase, "werase");
1126 if Werase (Win) = Curses_Err then
1127 raise Curses_Exception;
1131 procedure Clear (Win : Window := Standard_Window)
1133 function Wclear (W : Window) return C_Int;
1134 pragma Import (C, Wclear, "wclear");
1136 if Wclear (Win) = Curses_Err then
1137 raise Curses_Exception;
1141 procedure Clear_To_End_Of_Screen (Win : Window := Standard_Window)
1143 function Wclearbot (W : Window) return C_Int;
1144 pragma Import (C, Wclearbot, "wclrtobot");
1146 if Wclearbot (Win) = Curses_Err then
1147 raise Curses_Exception;
1149 end Clear_To_End_Of_Screen;
1151 procedure Clear_To_End_Of_Line (Win : Window := Standard_Window)
1153 function Wcleareol (W : Window) return C_Int;
1154 pragma Import (C, Wcleareol, "wclrtoeol");
1156 if Wcleareol (Win) = Curses_Err then
1157 raise Curses_Exception;
1159 end Clear_To_End_Of_Line;
1160 ------------------------------------------------------------------------------
1161 procedure Set_Background
1162 (Win : Window := Standard_Window;
1163 Ch : Attributed_Character)
1165 procedure WBackground (W : Window; Ch : Attributed_Character);
1166 pragma Import (C, WBackground, "wbkgdset");
1168 WBackground (Win, Ch);
1171 procedure Change_Background
1172 (Win : Window := Standard_Window;
1173 Ch : Attributed_Character)
1175 function WChangeBkgd (W : Window; Ch : Attributed_Character)
1177 pragma Import (C, WChangeBkgd, "wbkgd");
1179 if WChangeBkgd (Win, Ch) = Curses_Err then
1180 raise Curses_Exception;
1182 end Change_Background;
1184 function Get_Background (Win : Window := Standard_Window)
1185 return Attributed_Character
1187 function Wgetbkgd (Win : Window) return Attributed_Character;
1188 pragma Import (C, Wgetbkgd, "getbkgd");
1190 return Wgetbkgd (Win);
1192 ------------------------------------------------------------------------------
1193 procedure Change_Lines_Status (Win : Window := Standard_Window;
1194 Start : Line_Position;
1198 function Wtouchln (Win : Window;
1201 Chg : C_Int) return C_Int;
1202 pragma Import (C, Wtouchln, "wtouchln");
1204 if Wtouchln (Win, C_Int (Start), C_Int (Count),
1205 C_Int (Boolean'Pos (State))) = Curses_Err
1207 raise Curses_Exception;
1209 end Change_Lines_Status;
1211 procedure Touch (Win : Window := Standard_Window)
1214 X : Column_Position;
1216 Get_Size (Win, Y, X);
1217 pragma Warnings (Off, X); -- unreferenced
1218 Change_Lines_Status (Win, 0, Positive (Y), True);
1221 procedure Untouch (Win : Window := Standard_Window)
1224 X : Column_Position;
1226 Get_Size (Win, Y, X);
1227 pragma Warnings (Off, X); -- unreferenced
1228 Change_Lines_Status (Win, 0, Positive (Y), False);
1231 procedure Touch (Win : Window := Standard_Window;
1232 Start : Line_Position;
1236 Change_Lines_Status (Win, Start, Count, True);
1240 (Win : Window := Standard_Window;
1241 Line : Line_Position) return Boolean
1243 function WLineTouched (W : Window; L : C_Int) return Curses_Bool;
1244 pragma Import (C, WLineTouched, "is_linetouched");
1246 if WLineTouched (Win, C_Int (Line)) = Curses_Bool_False then
1254 (Win : Window := Standard_Window) return Boolean
1256 function WWinTouched (W : Window) return Curses_Bool;
1257 pragma Import (C, WWinTouched, "is_wintouched");
1259 if WWinTouched (Win) = Curses_Bool_False then
1265 ------------------------------------------------------------------------------
1267 (Source_Window : Window;
1268 Destination_Window : Window;
1269 Source_Top_Row : Line_Position;
1270 Source_Left_Column : Column_Position;
1271 Destination_Top_Row : Line_Position;
1272 Destination_Left_Column : Column_Position;
1273 Destination_Bottom_Row : Line_Position;
1274 Destination_Right_Column : Column_Position;
1275 Non_Destructive_Mode : Boolean := True)
1277 function Copywin (Src : Window;
1285 Ndm : C_Int) return C_Int;
1286 pragma Import (C, Copywin, "copywin");
1288 if Copywin (Source_Window,
1290 C_Int (Source_Top_Row),
1291 C_Int (Source_Left_Column),
1292 C_Int (Destination_Top_Row),
1293 C_Int (Destination_Left_Column),
1294 C_Int (Destination_Bottom_Row),
1295 C_Int (Destination_Right_Column),
1296 Boolean'Pos (Non_Destructive_Mode)
1299 raise Curses_Exception;
1304 (Source_Window : Window;
1305 Destination_Window : Window)
1307 function Overwrite (Src : Window; Dst : Window) return C_Int;
1308 pragma Import (C, Overwrite, "overwrite");
1310 if Overwrite (Source_Window, Destination_Window) = Curses_Err then
1311 raise Curses_Exception;
1316 (Source_Window : Window;
1317 Destination_Window : Window)
1319 function Overlay (Src : Window; Dst : Window) return C_Int;
1320 pragma Import (C, Overlay, "overlay");
1322 if Overlay (Source_Window, Destination_Window) = Curses_Err then
1323 raise Curses_Exception;
1327 ------------------------------------------------------------------------------
1328 procedure Insert_Delete_Lines
1329 (Win : Window := Standard_Window;
1330 Lines : Integer := 1) -- default is to insert one line above
1332 function Winsdelln (W : Window; N : C_Int) return C_Int;
1333 pragma Import (C, Winsdelln, "winsdelln");
1335 if Winsdelln (Win, C_Int (Lines)) = Curses_Err then
1336 raise Curses_Exception;
1338 end Insert_Delete_Lines;
1340 procedure Delete_Line (Win : Window := Standard_Window)
1343 Insert_Delete_Lines (Win, -1);
1346 procedure Insert_Line (Win : Window := Standard_Window)
1349 Insert_Delete_Lines (Win, 1);
1351 ------------------------------------------------------------------------------
1354 (Win : Window := Standard_Window;
1355 Number_Of_Lines : out Line_Count;
1356 Number_Of_Columns : out Column_Count)
1358 function GetMaxY (W : Window) return C_Int;
1359 pragma Import (C, GetMaxY, "getmaxy");
1361 function GetMaxX (W : Window) return C_Int;
1362 pragma Import (C, GetMaxX, "getmaxx");
1364 Y : constant C_Int := GetMaxY (Win);
1365 X : constant C_Int := GetMaxX (Win);
1367 Number_Of_Lines := Line_Count (Y);
1368 Number_Of_Columns := Column_Count (X);
1371 procedure Get_Window_Position
1372 (Win : Window := Standard_Window;
1373 Top_Left_Line : out Line_Position;
1374 Top_Left_Column : out Column_Position)
1376 function GetBegY (W : Window) return C_Int;
1377 pragma Import (C, GetBegY, "getbegy");
1379 function GetBegX (W : Window) return C_Int;
1380 pragma Import (C, GetBegX, "getbegx");
1382 Y : constant C_Short := C_Short (GetBegY (Win));
1383 X : constant C_Short := C_Short (GetBegX (Win));
1385 Top_Left_Line := Line_Position (Y);
1386 Top_Left_Column := Column_Position (X);
1387 end Get_Window_Position;
1389 procedure Get_Cursor_Position
1390 (Win : Window := Standard_Window;
1391 Line : out Line_Position;
1392 Column : out Column_Position)
1394 function GetCurY (W : Window) return C_Int;
1395 pragma Import (C, GetCurY, "getcury");
1397 function GetCurX (W : Window) return C_Int;
1398 pragma Import (C, GetCurX, "getcurx");
1400 Y : constant C_Short := C_Short (GetCurY (Win));
1401 X : constant C_Short := C_Short (GetCurX (Win));
1403 Line := Line_Position (Y);
1404 Column := Column_Position (X);
1405 end Get_Cursor_Position;
1407 procedure Get_Origin_Relative_To_Parent
1409 Top_Left_Line : out Line_Position;
1410 Top_Left_Column : out Column_Position;
1411 Is_Not_A_Subwindow : out Boolean)
1413 function GetParY (W : Window) return C_Int;
1414 pragma Import (C, GetParY, "getpary");
1416 function GetParX (W : Window) return C_Int;
1417 pragma Import (C, GetParX, "getparx");
1419 Y : constant C_Int := GetParY (Win);
1420 X : constant C_Int := GetParX (Win);
1423 Top_Left_Line := Line_Position'Last;
1424 Top_Left_Column := Column_Position'Last;
1425 Is_Not_A_Subwindow := True;
1427 Top_Left_Line := Line_Position (Y);
1428 Top_Left_Column := Column_Position (X);
1429 Is_Not_A_Subwindow := False;
1431 end Get_Origin_Relative_To_Parent;
1432 ------------------------------------------------------------------------------
1433 function New_Pad (Lines : Line_Count;
1434 Columns : Column_Count) return Window
1436 function Newpad (Lines : C_Int; Columns : C_Int) return Window;
1437 pragma Import (C, Newpad, "newpad");
1441 W := Newpad (C_Int (Lines), C_Int (Columns));
1442 if W = Null_Window then
1443 raise Curses_Exception;
1450 Number_Of_Lines : Line_Count;
1451 Number_Of_Columns : Column_Count;
1452 First_Line_Position : Line_Position;
1453 First_Column_Position : Column_Position) return Window
1457 Number_Of_Lines : C_Int;
1458 Number_Of_Columns : C_Int;
1459 First_Line_Position : C_Int;
1460 First_Column_Position : C_Int) return Window;
1461 pragma Import (C, Subpad, "subpad");
1466 C_Int (Number_Of_Lines),
1467 C_Int (Number_Of_Columns),
1468 C_Int (First_Line_Position),
1469 C_Int (First_Column_Position));
1470 if W = Null_Window then
1471 raise Curses_Exception;
1478 Source_Top_Row : Line_Position;
1479 Source_Left_Column : Column_Position;
1480 Destination_Top_Row : Line_Position;
1481 Destination_Left_Column : Column_Position;
1482 Destination_Bottom_Row : Line_Position;
1483 Destination_Right_Column : Column_Position)
1487 Source_Top_Row : C_Int;
1488 Source_Left_Column : C_Int;
1489 Destination_Top_Row : C_Int;
1490 Destination_Left_Column : C_Int;
1491 Destination_Bottom_Row : C_Int;
1492 Destination_Right_Column : C_Int) return C_Int;
1493 pragma Import (C, Prefresh, "prefresh");
1496 C_Int (Source_Top_Row),
1497 C_Int (Source_Left_Column),
1498 C_Int (Destination_Top_Row),
1499 C_Int (Destination_Left_Column),
1500 C_Int (Destination_Bottom_Row),
1501 C_Int (Destination_Right_Column)) = Curses_Err
1503 raise Curses_Exception;
1507 procedure Refresh_Without_Update
1509 Source_Top_Row : Line_Position;
1510 Source_Left_Column : Column_Position;
1511 Destination_Top_Row : Line_Position;
1512 Destination_Left_Column : Column_Position;
1513 Destination_Bottom_Row : Line_Position;
1514 Destination_Right_Column : Column_Position)
1516 function Pnoutrefresh
1518 Source_Top_Row : C_Int;
1519 Source_Left_Column : C_Int;
1520 Destination_Top_Row : C_Int;
1521 Destination_Left_Column : C_Int;
1522 Destination_Bottom_Row : C_Int;
1523 Destination_Right_Column : C_Int) return C_Int;
1524 pragma Import (C, Pnoutrefresh, "pnoutrefresh");
1526 if Pnoutrefresh (Pad,
1527 C_Int (Source_Top_Row),
1528 C_Int (Source_Left_Column),
1529 C_Int (Destination_Top_Row),
1530 C_Int (Destination_Left_Column),
1531 C_Int (Destination_Bottom_Row),
1532 C_Int (Destination_Right_Column)) = Curses_Err
1534 raise Curses_Exception;
1536 end Refresh_Without_Update;
1538 procedure Add_Character_To_Pad_And_Echo_It
1540 Ch : Attributed_Character)
1542 function Pechochar (Pad : Window; Ch : Attributed_Character)
1544 pragma Import (C, Pechochar, "pechochar");
1546 if Pechochar (Pad, Ch) = Curses_Err then
1547 raise Curses_Exception;
1549 end Add_Character_To_Pad_And_Echo_It;
1551 procedure Add_Character_To_Pad_And_Echo_It
1556 Add_Character_To_Pad_And_Echo_It
1558 Attributed_Character'(Ch => Ch,
1559 Color => Color_Pair'First,
1560 Attr => Normal_Video));
1561 end Add_Character_To_Pad_And_Echo_It;
1562 ------------------------------------------------------------------------------
1563 procedure Scroll (Win : Window := Standard_Window;
1564 Amount : Integer := 1)
1566 function Wscrl (Win : Window; N : C_Int) return C_Int;
1567 pragma Import (C, Wscrl, "wscrl");
1570 if Wscrl (Win, C_Int (Amount)) = Curses_Err then
1571 raise Curses_Exception;
1575 ------------------------------------------------------------------------------
1576 procedure Delete_Character (Win : Window := Standard_Window)
1578 function Wdelch (Win : Window) return C_Int;
1579 pragma Import (C, Wdelch, "wdelch");
1581 if Wdelch (Win) = Curses_Err then
1582 raise Curses_Exception;
1584 end Delete_Character;
1586 procedure Delete_Character
1587 (Win : Window := Standard_Window;
1588 Line : Line_Position;
1589 Column : Column_Position)
1591 function Mvwdelch (Win : Window;
1593 Col : C_Int) return C_Int;
1594 pragma Import (C, Mvwdelch, "mvwdelch");
1596 if Mvwdelch (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
1597 raise Curses_Exception;
1599 end Delete_Character;
1600 ------------------------------------------------------------------------------
1601 function Peek (Win : Window := Standard_Window)
1602 return Attributed_Character
1604 function Winch (Win : Window) return Attributed_Character;
1605 pragma Import (C, Winch, "winch");
1611 (Win : Window := Standard_Window;
1612 Line : Line_Position;
1613 Column : Column_Position) return Attributed_Character
1615 function Mvwinch (Win : Window;
1617 Col : C_Int) return Attributed_Character;
1618 pragma Import (C, Mvwinch, "mvwinch");
1620 return Mvwinch (Win, C_Int (Line), C_Int (Column));
1622 ------------------------------------------------------------------------------
1623 procedure Insert (Win : Window := Standard_Window;
1624 Ch : Attributed_Character)
1626 function Winsch (Win : Window; Ch : Attributed_Character) return C_Int;
1627 pragma Import (C, Winsch, "winsch");
1629 if Winsch (Win, Ch) = Curses_Err then
1630 raise Curses_Exception;
1635 (Win : Window := Standard_Window;
1636 Line : Line_Position;
1637 Column : Column_Position;
1638 Ch : Attributed_Character)
1640 function Mvwinsch (Win : Window;
1643 Ch : Attributed_Character) return C_Int;
1644 pragma Import (C, Mvwinsch, "mvwinsch");
1651 raise Curses_Exception;
1654 ------------------------------------------------------------------------------
1655 procedure Insert (Win : Window := Standard_Window;
1657 Len : Integer := -1)
1659 function Winsnstr (Win : Window;
1661 Len : Integer := -1) return C_Int;
1662 pragma Import (C, Winsnstr, "winsnstr");
1664 Txt : char_array (0 .. Str'Length);
1667 To_C (Str, Txt, Length);
1668 if Winsnstr (Win, Txt, Len) = Curses_Err then
1669 raise Curses_Exception;
1674 (Win : Window := Standard_Window;
1675 Line : Line_Position;
1676 Column : Column_Position;
1678 Len : Integer := -1)
1680 function Mvwinsnstr (Win : Window;
1684 Len : C_Int) return C_Int;
1685 pragma Import (C, Mvwinsnstr, "mvwinsnstr");
1687 Txt : char_array (0 .. Str'Length);
1690 To_C (Str, Txt, Length);
1691 if Mvwinsnstr (Win, C_Int (Line), C_Int (Column), Txt, C_Int (Len))
1694 raise Curses_Exception;
1697 ------------------------------------------------------------------------------
1698 procedure Peek (Win : Window := Standard_Window;
1700 Len : Integer := -1)
1702 function Winnstr (Win : Window;
1704 Len : C_Int) return C_Int;
1705 pragma Import (C, Winnstr, "winnstr");
1708 Txt : char_array (0 .. Str'Length);
1714 if N > Str'Length then
1715 raise Constraint_Error;
1717 Txt (0) := Interfaces.C.char'First;
1718 if Winnstr (Win, Txt, C_Int (N)) = Curses_Err then
1719 raise Curses_Exception;
1721 To_Ada (Txt, Str, Cnt, True);
1722 if Cnt < Str'Length then
1723 Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
1728 (Win : Window := Standard_Window;
1729 Line : Line_Position;
1730 Column : Column_Position;
1732 Len : Integer := -1)
1735 Move_Cursor (Win, Line, Column);
1736 Peek (Win, Str, Len);
1738 ------------------------------------------------------------------------------
1740 (Win : Window := Standard_Window;
1741 Str : out Attributed_String;
1742 Len : Integer := -1)
1744 function Winchnstr (Win : Window;
1745 Str : chtype_array; -- out
1746 Len : C_Int) return C_Int;
1747 pragma Import (C, Winchnstr, "winchnstr");
1750 Txt : constant chtype_array (0 .. Str'Length)
1751 := (0 => Default_Character);
1757 if N > Str'Length then
1758 raise Constraint_Error;
1760 if Winchnstr (Win, Txt, C_Int (N)) = Curses_Err then
1761 raise Curses_Exception;
1763 for To in Str'Range loop
1764 exit when Txt (size_t (Cnt)) = Default_Character;
1765 Str (To) := Txt (size_t (Cnt));
1768 if Cnt < Str'Length then
1769 Str ((Str'First + Cnt) .. Str'Last) :=
1770 (others => (Ch => ' ',
1771 Color => Color_Pair'First,
1772 Attr => Normal_Video));
1777 (Win : Window := Standard_Window;
1778 Line : Line_Position;
1779 Column : Column_Position;
1780 Str : out Attributed_String;
1781 Len : Integer := -1)
1784 Move_Cursor (Win, Line, Column);
1785 Peek (Win, Str, Len);
1787 ------------------------------------------------------------------------------
1788 procedure Get (Win : Window := Standard_Window;
1790 Len : Integer := -1)
1792 function Wgetnstr (Win : Window;
1794 Len : C_Int) return C_Int;
1795 pragma Import (C, Wgetnstr, "wgetnstr");
1798 Txt : char_array (0 .. Str'Length);
1804 if N > Str'Length then
1805 raise Constraint_Error;
1807 Txt (0) := Interfaces.C.char'First;
1808 if Wgetnstr (Win, Txt, C_Int (N)) = Curses_Err then
1809 raise Curses_Exception;
1811 To_Ada (Txt, Str, Cnt, True);
1812 if Cnt < Str'Length then
1813 Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
1818 (Win : Window := Standard_Window;
1819 Line : Line_Position;
1820 Column : Column_Position;
1822 Len : Integer := -1)
1825 Move_Cursor (Win, Line, Column);
1826 Get (Win, Str, Len);
1828 ------------------------------------------------------------------------------
1829 procedure Init_Soft_Label_Keys
1830 (Format : Soft_Label_Key_Format := Three_Two_Three)
1832 function Slk_Init (Fmt : C_Int) return C_Int;
1833 pragma Import (C, Slk_Init, "slk_init");
1835 if Slk_Init (Soft_Label_Key_Format'Pos (Format)) = Curses_Err then
1836 raise Curses_Exception;
1838 end Init_Soft_Label_Keys;
1840 procedure Set_Soft_Label_Key (Label : Label_Number;
1842 Fmt : Label_Justification := Left)
1844 function Slk_Set (Label : C_Int;
1846 Fmt : C_Int) return C_Int;
1847 pragma Import (C, Slk_Set, "slk_set");
1849 Txt : char_array (0 .. Text'Length);
1852 To_C (Text, Txt, Len);
1853 if Slk_Set (C_Int (Label), Txt,
1854 C_Int (Label_Justification'Pos (Fmt))) = Curses_Err
1856 raise Curses_Exception;
1858 end Set_Soft_Label_Key;
1860 procedure Refresh_Soft_Label_Keys
1862 function Slk_Refresh return C_Int;
1863 pragma Import (C, Slk_Refresh, "slk_refresh");
1865 if Slk_Refresh = Curses_Err then
1866 raise Curses_Exception;
1868 end Refresh_Soft_Label_Keys;
1870 procedure Refresh_Soft_Label_Keys_Without_Update
1872 function Slk_Noutrefresh return C_Int;
1873 pragma Import (C, Slk_Noutrefresh, "slk_noutrefresh");
1875 if Slk_Noutrefresh = Curses_Err then
1876 raise Curses_Exception;
1878 end Refresh_Soft_Label_Keys_Without_Update;
1880 procedure Get_Soft_Label_Key (Label : Label_Number;
1883 function Slk_Label (Label : C_Int) return chars_ptr;
1884 pragma Import (C, Slk_Label, "slk_label");
1886 Fill_String (Slk_Label (C_Int (Label)), Text);
1887 end Get_Soft_Label_Key;
1889 function Get_Soft_Label_Key (Label : Label_Number) return String
1891 function Slk_Label (Label : C_Int) return chars_ptr;
1892 pragma Import (C, Slk_Label, "slk_label");
1894 return Fill_String (Slk_Label (C_Int (Label)));
1895 end Get_Soft_Label_Key;
1897 procedure Clear_Soft_Label_Keys
1899 function Slk_Clear return C_Int;
1900 pragma Import (C, Slk_Clear, "slk_clear");
1902 if Slk_Clear = Curses_Err then
1903 raise Curses_Exception;
1905 end Clear_Soft_Label_Keys;
1907 procedure Restore_Soft_Label_Keys
1909 function Slk_Restore return C_Int;
1910 pragma Import (C, Slk_Restore, "slk_restore");
1912 if Slk_Restore = Curses_Err then
1913 raise Curses_Exception;
1915 end Restore_Soft_Label_Keys;
1917 procedure Touch_Soft_Label_Keys
1919 function Slk_Touch return C_Int;
1920 pragma Import (C, Slk_Touch, "slk_touch");
1922 if Slk_Touch = Curses_Err then
1923 raise Curses_Exception;
1925 end Touch_Soft_Label_Keys;
1927 procedure Switch_Soft_Label_Key_Attributes
1928 (Attr : Character_Attribute_Set;
1929 On : Boolean := True)
1931 function Slk_Attron (Ch : Attributed_Character) return C_Int;
1932 pragma Import (C, Slk_Attron, "slk_attron");
1933 function Slk_Attroff (Ch : Attributed_Character) return C_Int;
1934 pragma Import (C, Slk_Attroff, "slk_attroff");
1937 Ch : constant Attributed_Character := (Ch => Character'First,
1939 Color => Color_Pair'First);
1942 Err := Slk_Attron (Ch);
1944 Err := Slk_Attroff (Ch);
1946 if Err = Curses_Err then
1947 raise Curses_Exception;
1949 end Switch_Soft_Label_Key_Attributes;
1951 procedure Set_Soft_Label_Key_Attributes
1952 (Attr : Character_Attribute_Set := Normal_Video;
1953 Color : Color_Pair := Color_Pair'First)
1955 function Slk_Attrset (Ch : Attributed_Character) return C_Int;
1956 pragma Import (C, Slk_Attrset, "slk_attrset");
1958 Ch : constant Attributed_Character := (Ch => Character'First,
1962 if Slk_Attrset (Ch) = Curses_Err then
1963 raise Curses_Exception;
1965 end Set_Soft_Label_Key_Attributes;
1967 function Get_Soft_Label_Key_Attributes return Character_Attribute_Set
1969 function Slk_Attr return Attributed_Character;
1970 pragma Import (C, Slk_Attr, "slk_attr");
1972 Attr : constant Attributed_Character := Slk_Attr;
1975 end Get_Soft_Label_Key_Attributes;
1977 function Get_Soft_Label_Key_Attributes return Color_Pair
1979 function Slk_Attr return Attributed_Character;
1980 pragma Import (C, Slk_Attr, "slk_attr");
1982 Attr : constant Attributed_Character := Slk_Attr;
1985 end Get_Soft_Label_Key_Attributes;
1987 procedure Set_Soft_Label_Key_Color (Pair : Color_Pair)
1989 function Slk_Color (Color : C_Short) return C_Int;
1990 pragma Import (C, Slk_Color, "slk_color");
1992 if Slk_Color (C_Short (Pair)) = Curses_Err then
1993 raise Curses_Exception;
1995 end Set_Soft_Label_Key_Color;
1997 ------------------------------------------------------------------------------
1998 procedure Enable_Key (Key : Special_Key_Code;
1999 Enable : Boolean := True)
2001 function Keyok (Keycode : C_Int;
2002 On_Off : Curses_Bool) return C_Int;
2003 pragma Import (C, Keyok, "keyok");
2005 if Keyok (C_Int (Key), Curses_Bool (Boolean'Pos (Enable)))
2008 raise Curses_Exception;
2011 ------------------------------------------------------------------------------
2012 procedure Define_Key (Definition : String;
2013 Key : Special_Key_Code)
2015 function Defkey (Def : char_array;
2016 Key : C_Int) return C_Int;
2017 pragma Import (C, Defkey, "define_key");
2019 Txt : char_array (0 .. Definition'Length);
2022 To_C (Definition, Txt, Length);
2023 if Defkey (Txt, C_Int (Key)) = Curses_Err then
2024 raise Curses_Exception;
2027 ------------------------------------------------------------------------------
2028 procedure Un_Control (Ch : Attributed_Character;
2031 function Unctrl (Ch : Attributed_Character) return chars_ptr;
2032 pragma Import (C, Unctrl, "unctrl");
2034 Fill_String (Unctrl (Ch), Str);
2037 function Un_Control (Ch : Attributed_Character) return String
2039 function Unctrl (Ch : Attributed_Character) return chars_ptr;
2040 pragma Import (C, Unctrl, "unctrl");
2042 return Fill_String (Unctrl (Ch));
2045 procedure Delay_Output (Msecs : Natural)
2047 function Delayoutput (Msecs : C_Int) return C_Int;
2048 pragma Import (C, Delayoutput, "delay_output");
2050 if Delayoutput (C_Int (Msecs)) = Curses_Err then
2051 raise Curses_Exception;
2055 procedure Flush_Input
2057 function Flushinp return C_Int;
2058 pragma Import (C, Flushinp, "flushinp");
2060 if Flushinp = Curses_Err then -- docu says that never happens, but...
2061 raise Curses_Exception;
2064 ------------------------------------------------------------------------------
2065 function Baudrate return Natural
2067 function Baud return C_Int;
2068 pragma Import (C, Baud, "baudrate");
2070 return Natural (Baud);
2073 function Erase_Character return Character
2075 function Erasechar return C_Int;
2076 pragma Import (C, Erasechar, "erasechar");
2078 return Character'Val (Erasechar);
2079 end Erase_Character;
2081 function Kill_Character return Character
2083 function Killchar return C_Int;
2084 pragma Import (C, Killchar, "killchar");
2086 return Character'Val (Killchar);
2089 function Has_Insert_Character return Boolean
2091 function Has_Ic return Curses_Bool;
2092 pragma Import (C, Has_Ic, "has_ic");
2094 if Has_Ic = Curses_Bool_False then
2099 end Has_Insert_Character;
2101 function Has_Insert_Line return Boolean
2103 function Has_Il return Curses_Bool;
2104 pragma Import (C, Has_Il, "has_il");
2106 if Has_Il = Curses_Bool_False then
2111 end Has_Insert_Line;
2113 function Supported_Attributes return Character_Attribute_Set
2115 function Termattrs return Attributed_Character;
2116 pragma Import (C, Termattrs, "termattrs");
2118 Ch : constant Attributed_Character := Termattrs;
2121 end Supported_Attributes;
2123 procedure Long_Name (Name : out String)
2125 function Longname return chars_ptr;
2126 pragma Import (C, Longname, "longname");
2128 Fill_String (Longname, Name);
2131 function Long_Name return String
2133 function Longname return chars_ptr;
2134 pragma Import (C, Longname, "longname");
2136 return Fill_String (Longname);
2139 procedure Terminal_Name (Name : out String)
2141 function Termname return chars_ptr;
2142 pragma Import (C, Termname, "termname");
2144 Fill_String (Termname, Name);
2147 function Terminal_Name return String
2149 function Termname return chars_ptr;
2150 pragma Import (C, Termname, "termname");
2152 return Fill_String (Termname);
2154 ------------------------------------------------------------------------------
2155 procedure Init_Pair (Pair : Redefinable_Color_Pair;
2156 Fore : Color_Number;
2157 Back : Color_Number)
2159 function Initpair (Pair : C_Short;
2161 Back : C_Short) return C_Int;
2162 pragma Import (C, Initpair, "init_pair");
2164 if Integer (Pair) >= Number_Of_Color_Pairs then
2165 raise Constraint_Error;
2167 if Integer (Fore) >= Number_Of_Colors or else
2168 Integer (Back) >= Number_Of_Colors
2170 raise Constraint_Error;
2172 if Initpair (C_Short (Pair), C_Short (Fore), C_Short (Back))
2175 raise Curses_Exception;
2179 procedure Pair_Content (Pair : Color_Pair;
2180 Fore : out Color_Number;
2181 Back : out Color_Number)
2183 type C_Short_Access is access all C_Short;
2184 function Paircontent (Pair : C_Short;
2185 Fp : C_Short_Access;
2186 Bp : C_Short_Access) return C_Int;
2187 pragma Import (C, Paircontent, "pair_content");
2189 F, B : aliased C_Short;
2191 if Paircontent (C_Short (Pair), F'Access, B'Access) = Curses_Err then
2192 raise Curses_Exception;
2194 Fore := Color_Number (F);
2195 Back := Color_Number (B);
2199 function Has_Colors return Boolean
2201 function Hascolors return Curses_Bool;
2202 pragma Import (C, Hascolors, "has_colors");
2204 if Hascolors = Curses_Bool_False then
2211 procedure Init_Color (Color : Color_Number;
2216 function Initcolor (Col : C_Short;
2219 Blue : C_Short) return C_Int;
2220 pragma Import (C, Initcolor, "init_color");
2222 if Initcolor (C_Short (Color), C_Short (Red), C_Short (Green),
2223 C_Short (Blue)) = Curses_Err
2225 raise Curses_Exception;
2229 function Can_Change_Color return Boolean
2231 function Canchangecolor return Curses_Bool;
2232 pragma Import (C, Canchangecolor, "can_change_color");
2234 if Canchangecolor = Curses_Bool_False then
2239 end Can_Change_Color;
2241 procedure Color_Content (Color : Color_Number;
2242 Red : out RGB_Value;
2243 Green : out RGB_Value;
2244 Blue : out RGB_Value)
2246 type C_Short_Access is access all C_Short;
2248 function Colorcontent (Color : C_Short; R, G, B : C_Short_Access)
2250 pragma Import (C, Colorcontent, "color_content");
2252 R, G, B : aliased C_Short;
2254 if Colorcontent (C_Short (Color), R'Access, G'Access, B'Access) =
2257 raise Curses_Exception;
2259 Red := RGB_Value (R);
2260 Green := RGB_Value (G);
2261 Blue := RGB_Value (B);
2265 ------------------------------------------------------------------------------
2266 procedure Save_Curses_Mode (Mode : Curses_Mode)
2268 function Def_Prog_Mode return C_Int;
2269 pragma Import (C, Def_Prog_Mode, "def_prog_mode");
2270 function Def_Shell_Mode return C_Int;
2271 pragma Import (C, Def_Shell_Mode, "def_shell_mode");
2276 when Curses => Err := Def_Prog_Mode;
2277 when Shell => Err := Def_Shell_Mode;
2279 if Err = Curses_Err then
2280 raise Curses_Exception;
2282 end Save_Curses_Mode;
2284 procedure Reset_Curses_Mode (Mode : Curses_Mode)
2286 function Reset_Prog_Mode return C_Int;
2287 pragma Import (C, Reset_Prog_Mode, "reset_prog_mode");
2288 function Reset_Shell_Mode return C_Int;
2289 pragma Import (C, Reset_Shell_Mode, "reset_shell_mode");
2294 when Curses => Err := Reset_Prog_Mode;
2295 when Shell => Err := Reset_Shell_Mode;
2297 if Err = Curses_Err then
2298 raise Curses_Exception;
2300 end Reset_Curses_Mode;
2302 procedure Save_Terminal_State
2304 function Savetty return C_Int;
2305 pragma Import (C, Savetty, "savetty");
2307 if Savetty = Curses_Err then
2308 raise Curses_Exception;
2310 end Save_Terminal_State;
2312 procedure Reset_Terminal_State
2314 function Resetty return C_Int;
2315 pragma Import (C, Resetty, "resetty");
2317 if Resetty = Curses_Err then
2318 raise Curses_Exception;
2320 end Reset_Terminal_State;
2322 procedure Rip_Off_Lines (Lines : Integer;
2323 Proc : Stdscr_Init_Proc)
2325 function Ripoffline (Lines : C_Int;
2326 Proc : Stdscr_Init_Proc) return C_Int;
2327 pragma Import (C, Ripoffline, "_nc_ripoffline");
2329 if Ripoffline (C_Int (Lines), Proc) = Curses_Err then
2330 raise Curses_Exception;
2334 procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility)
2336 function Curs_Set (Curs : C_Int) return C_Int;
2337 pragma Import (C, Curs_Set, "curs_set");
2341 Res := Curs_Set (Cursor_Visibility'Pos (Visibility));
2342 if Res /= Curses_Err then
2343 Visibility := Cursor_Visibility'Val (Res);
2345 end Set_Cursor_Visibility;
2347 procedure Nap_Milli_Seconds (Ms : Natural)
2349 function Napms (Ms : C_Int) return C_Int;
2350 pragma Import (C, Napms, "napms");
2352 if Napms (C_Int (Ms)) = Curses_Err then
2353 raise Curses_Exception;
2355 end Nap_Milli_Seconds;
2356 ------------------------------------------------------------------------------
2357 function Lines return Line_Count
2359 function LINES_As_Function return Interfaces.C.int;
2360 pragma Import (C, LINES_As_Function, "LINES_as_function");
2362 return Line_Count (LINES_As_Function);
2365 function Columns return Column_Count
2367 function COLS_As_Function return Interfaces.C.int;
2368 pragma Import (C, COLS_As_Function, "COLS_as_function");
2370 return Column_Count (COLS_As_Function);
2373 function Tab_Size return Natural
2375 function TABSIZE_As_Function return Interfaces.C.int;
2376 pragma Import (C, TABSIZE_As_Function, "TABSIZE_as_function");
2379 return Natural (TABSIZE_As_Function);
2382 function Number_Of_Colors return Natural
2384 function COLORS_As_Function return Interfaces.C.int;
2385 pragma Import (C, COLORS_As_Function, "COLORS_as_function");
2387 return Natural (COLORS_As_Function);
2388 end Number_Of_Colors;
2390 function Number_Of_Color_Pairs return Natural
2392 function COLOR_PAIRS_As_Function return Interfaces.C.int;
2393 pragma Import (C, COLOR_PAIRS_As_Function, "COLOR_PAIRS_as_function");
2395 return Natural (COLOR_PAIRS_As_Function);
2396 end Number_Of_Color_Pairs;
2397 ------------------------------------------------------------------------------
2398 procedure Transform_Coordinates
2399 (W : Window := Standard_Window;
2400 Line : in out Line_Position;
2401 Column : in out Column_Position;
2402 Dir : Transform_Direction := From_Screen)
2404 type Int_Access is access all C_Int;
2405 function Transform (W : Window;
2407 Dir : Curses_Bool) return C_Int;
2408 pragma Import (C, Transform, "wmouse_trafo");
2410 X : aliased C_Int := C_Int (Column);
2411 Y : aliased C_Int := C_Int (Line);
2412 D : Curses_Bool := Curses_Bool_False;
2415 if Dir = To_Screen then
2418 R := Transform (W, Y'Access, X'Access, D);
2419 if R = Curses_False then
2420 raise Curses_Exception;
2422 Line := Line_Position (Y);
2423 Column := Column_Position (X);
2425 end Transform_Coordinates;
2426 ------------------------------------------------------------------------------
2427 procedure Use_Default_Colors is
2428 function C_Use_Default_Colors return C_Int;
2429 pragma Import (C, C_Use_Default_Colors, "use_default_colors");
2430 Err : constant C_Int := C_Use_Default_Colors;
2432 if Err = Curses_Err then
2433 raise Curses_Exception;
2435 end Use_Default_Colors;
2437 procedure Assume_Default_Colors (Fore : Color_Number := Default_Color;
2438 Back : Color_Number := Default_Color)
2440 function C_Assume_Default_Colors (Fore : C_Int;
2441 Back : C_Int) return C_Int;
2442 pragma Import (C, C_Assume_Default_Colors, "assume_default_colors");
2444 Err : constant C_Int := C_Assume_Default_Colors (C_Int (Fore),
2447 if Err = Curses_Err then
2448 raise Curses_Exception;
2450 end Assume_Default_Colors;
2451 ------------------------------------------------------------------------------
2452 function Curses_Version return String
2454 function curses_versionC return chars_ptr;
2455 pragma Import (C, curses_versionC, "curses_version");
2456 Result : constant chars_ptr := curses_versionC;
2458 return Fill_String (Result);
2460 ------------------------------------------------------------------------------
2461 procedure Curses_Free_All is
2462 procedure curses_freeall;
2463 pragma Import (C, curses_freeall, "_nc_freeall");
2465 -- Use this only for testing: you cannot use curses after calling it,
2466 -- so it has to be the "last" thing done before exiting the program.
2467 -- This will not really free ALL of memory used by curses. That is
2468 -- because it cannot free the memory used for stdout's setbuf. The
2469 -- _nc_free_and_exit() procedure can do that, but it can be invoked
2470 -- safely only from C - and again, that only as the "last" thing done
2471 -- before exiting the program.
2473 end Curses_Free_All;
2474 ------------------------------------------------------------------------------
2475 function Use_Extended_Names (Enable : Boolean) return Boolean
2477 function use_extended_namesC (e : Curses_Bool) return C_Int;
2478 pragma Import (C, use_extended_namesC, "use_extended_names");
2480 Res : constant C_Int :=
2481 use_extended_namesC (Curses_Bool (Boolean'Pos (Enable)));
2483 if Res = C_Int (Curses_Bool_False) then
2488 end Use_Extended_Names;
2489 ------------------------------------------------------------------------------
2490 procedure Screen_Dump_To_File (Filename : String)
2492 function scr_dump (f : char_array) return C_Int;
2493 pragma Import (C, scr_dump, "scr_dump");
2494 Txt : char_array (0 .. Filename'Length);
2497 To_C (Filename, Txt, Length);
2498 if Curses_Err = scr_dump (Txt) then
2499 raise Curses_Exception;
2501 end Screen_Dump_To_File;
2503 procedure Screen_Restore_From_File (Filename : String)
2505 function scr_restore (f : char_array) return C_Int;
2506 pragma Import (C, scr_restore, "scr_restore");
2507 Txt : char_array (0 .. Filename'Length);
2510 To_C (Filename, Txt, Length);
2511 if Curses_Err = scr_restore (Txt) then
2512 raise Curses_Exception;
2514 end Screen_Restore_From_File;
2516 procedure Screen_Init_From_File (Filename : String)
2518 function scr_init (f : char_array) return C_Int;
2519 pragma Import (C, scr_init, "scr_init");
2520 Txt : char_array (0 .. Filename'Length);
2523 To_C (Filename, Txt, Length);
2524 if Curses_Err = scr_init (Txt) then
2525 raise Curses_Exception;
2527 end Screen_Init_From_File;
2529 procedure Screen_Set_File (Filename : String)
2531 function scr_set (f : char_array) return C_Int;
2532 pragma Import (C, scr_set, "scr_set");
2533 Txt : char_array (0 .. Filename'Length);
2536 To_C (Filename, Txt, Length);
2537 if Curses_Err = scr_set (Txt) then
2538 raise Curses_Exception;
2540 end Screen_Set_File;
2541 ------------------------------------------------------------------------------
2542 procedure Resize (Win : Window := Standard_Window;
2543 Number_Of_Lines : Line_Count;
2544 Number_Of_Columns : Column_Count) is
2545 function wresize (win : Window;
2547 columns : C_Int) return C_Int;
2548 pragma Import (C, wresize);
2551 C_Int (Number_Of_Lines),
2552 C_Int (Number_Of_Columns)) = Curses_Err
2554 raise Curses_Exception;
2557 ------------------------------------------------------------------------------
2559 end Terminal_Interface.Curses;