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-2014,2018 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: 2018/07/07 23:28:45 $
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
56 package ASF renames Ada.Strings.Fixed;
58 type chtype_array is array (size_t range <>)
59 of aliased Attributed_Character;
60 pragma Convention (C, chtype_array);
62 ------------------------------------------------------------------------------
63 function Key_Name (Key : Real_Key_Code) return String
65 function Keyname (K : C_Int) return chars_ptr;
66 pragma Import (C, Keyname, "keyname");
70 if Key <= Character'Pos (Character'Last) then
71 Ch := Character'Val (Key);
72 if Is_Control (Ch) then
73 return Un_Control (Attributed_Character'(Ch => Ch,
74 Color => Color_Pair'First,
75 Attr => Normal_Video));
76 elsif Is_Graphic (Ch) then
87 return Fill_String (Keyname (C_Int (Key)));
91 procedure Key_Name (Key : Real_Key_Code;
95 ASF.Move (Key_Name (Key), Name);
98 ------------------------------------------------------------------------------
101 function Initscr return Window;
102 pragma Import (C, Initscr, "initscr");
107 if W = Null_Window then
108 raise Curses_Exception;
112 procedure End_Windows
114 function Endwin return C_Int;
115 pragma Import (C, Endwin, "endwin");
117 if Endwin = Curses_Err then
118 raise Curses_Exception;
122 function Is_End_Window return Boolean
124 function Isendwin return Curses_Bool;
125 pragma Import (C, Isendwin, "isendwin");
127 if Isendwin = Curses_Bool_False then
133 ------------------------------------------------------------------------------
134 procedure Move_Cursor (Win : Window := Standard_Window;
135 Line : Line_Position;
136 Column : Column_Position)
138 function Wmove (Win : Window;
142 pragma Import (C, Wmove, "wmove");
144 if Wmove (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
145 raise Curses_Exception;
148 ------------------------------------------------------------------------------
149 procedure Add (Win : Window := Standard_Window;
150 Ch : Attributed_Character)
152 function Waddch (W : Window;
153 Ch : Attributed_Character) return C_Int;
154 pragma Import (C, Waddch, "waddch");
156 if Waddch (Win, Ch) = Curses_Err then
157 raise Curses_Exception;
161 procedure Add (Win : Window := Standard_Window;
166 Attributed_Character'(Ch => Ch,
167 Color => Color_Pair'First,
168 Attr => Normal_Video));
172 (Win : Window := Standard_Window;
173 Line : Line_Position;
174 Column : Column_Position;
175 Ch : Attributed_Character)
177 function mvwaddch (W : Window;
180 Ch : Attributed_Character) return C_Int;
181 pragma Import (C, mvwaddch, "mvwaddch");
183 if mvwaddch (Win, C_Int (Line),
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 : Attributed_Character) return C_Int;
212 pragma Import (C, Wechochar, "wechochar");
214 if Wechochar (Win, 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
424 raise Curses_Exception;
429 (Win : Window := Standard_Window;
430 Line : Line_Position;
431 Column : Column_Position;
432 Str : Attributed_String;
436 Move_Cursor (Win, Line, Column);
439 ------------------------------------------------------------------------------
441 (Win : Window := Standard_Window;
442 Left_Side_Symbol : Attributed_Character := Default_Character;
443 Right_Side_Symbol : Attributed_Character := Default_Character;
444 Top_Side_Symbol : Attributed_Character := Default_Character;
445 Bottom_Side_Symbol : Attributed_Character := Default_Character;
446 Upper_Left_Corner_Symbol : Attributed_Character := Default_Character;
447 Upper_Right_Corner_Symbol : Attributed_Character := Default_Character;
448 Lower_Left_Corner_Symbol : Attributed_Character := Default_Character;
449 Lower_Right_Corner_Symbol : Attributed_Character := Default_Character)
451 function Wborder (W : Window;
452 LS : Attributed_Character;
453 RS : Attributed_Character;
454 TS : Attributed_Character;
455 BS : Attributed_Character;
456 ULC : Attributed_Character;
457 URC : Attributed_Character;
458 LLC : Attributed_Character;
459 LRC : Attributed_Character) return C_Int;
460 pragma Import (C, Wborder, "wborder");
467 Upper_Left_Corner_Symbol,
468 Upper_Right_Corner_Symbol,
469 Lower_Left_Corner_Symbol,
470 Lower_Right_Corner_Symbol) = Curses_Err
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;
493 Ch : Attributed_Character;
494 Len : C_Int) return C_Int;
495 pragma Import (C, Whline, "whline");
499 C_Int (Line_Size)) = Curses_Err
501 raise Curses_Exception;
505 procedure Vertical_Line
506 (Win : Window := Standard_Window;
508 Line_Symbol : Attributed_Character := Default_Character)
510 function Wvline (W : Window;
511 Ch : Attributed_Character;
512 Len : C_Int) return C_Int;
513 pragma Import (C, Wvline, "wvline");
517 C_Int (Line_Size)) = Curses_Err
519 raise Curses_Exception;
523 ------------------------------------------------------------------------------
524 function Get_Keystroke (Win : Window := Standard_Window)
527 function Wgetch (W : Window) return C_Int;
528 pragma Import (C, Wgetch, "wgetch");
530 C : constant C_Int := Wgetch (Win);
532 if C = Curses_Err then
535 return Real_Key_Code (C);
539 procedure Undo_Keystroke (Key : Real_Key_Code)
541 function Ungetch (Ch : C_Int) return C_Int;
542 pragma Import (C, Ungetch, "ungetch");
544 if Ungetch (C_Int (Key)) = Curses_Err then
545 raise Curses_Exception;
549 function Has_Key (Key : Special_Key_Code) return Boolean
551 function Haskey (Key : C_Int) return C_Int;
552 pragma Import (C, Haskey, "has_key");
554 if Haskey (C_Int (Key)) = Curses_False then
561 function Is_Function_Key (Key : Special_Key_Code) return Boolean
563 L : constant Special_Key_Code := Special_Key_Code (Natural (Key_F0) +
564 Natural (Function_Key_Number'Last));
566 if (Key >= Key_F0) and then (Key <= L) then
573 function Function_Key (Key : Real_Key_Code)
574 return Function_Key_Number
577 if Is_Function_Key (Key) then
578 return Function_Key_Number (Key - Key_F0);
580 raise Constraint_Error;
584 function Function_Key_Code (Key : Function_Key_Number) return Real_Key_Code
587 return Real_Key_Code (Natural (Key_F0) + Natural (Key));
588 end Function_Key_Code;
589 ------------------------------------------------------------------------------
590 procedure Standout (Win : Window := Standard_Window;
591 On : Boolean := True)
593 function wstandout (Win : Window) return C_Int;
594 pragma Import (C, wstandout, "wstandout");
595 function wstandend (Win : Window) return C_Int;
596 pragma Import (C, wstandend, "wstandend");
601 Err := wstandout (Win);
603 Err := wstandend (Win);
605 if Err = Curses_Err then
606 raise Curses_Exception;
610 procedure Switch_Character_Attribute
611 (Win : Window := Standard_Window;
612 Attr : Character_Attribute_Set := Normal_Video;
613 On : Boolean := True)
615 function Wattron (Win : Window;
616 C_Attr : Attributed_Character) return C_Int;
617 pragma Import (C, Wattron, "wattr_on");
618 function Wattroff (Win : Window;
619 C_Attr : Attributed_Character) return C_Int;
620 pragma Import (C, Wattroff, "wattr_off");
621 -- In Ada we use the On Boolean to control whether or not we want to
622 -- switch on or off the attributes in the set.
624 AC : constant Attributed_Character := (Ch => Character'First,
625 Color => Color_Pair'First,
629 Err := Wattron (Win, AC);
631 Err := Wattroff (Win, AC);
633 if Err = Curses_Err then
634 raise Curses_Exception;
636 end Switch_Character_Attribute;
638 procedure Set_Character_Attributes
639 (Win : Window := Standard_Window;
640 Attr : Character_Attribute_Set := Normal_Video;
641 Color : Color_Pair := Color_Pair'First)
643 function Wattrset (Win : Window;
644 C_Attr : Attributed_Character) return C_Int;
645 pragma Import (C, Wattrset, "wattrset"); -- ??? wattr_set
647 if Wattrset (Win, (Ch => Character'First,
649 Attr => Attr)) = Curses_Err
651 raise Curses_Exception;
653 end Set_Character_Attributes;
655 function Get_Character_Attribute (Win : Window := Standard_Window)
656 return Character_Attribute_Set
658 function Wattrget (Win : Window;
659 Atr : access Attributed_Character;
660 Col : access C_Short;
661 Opt : System.Address) return C_Int;
662 pragma Import (C, Wattrget, "wattr_get");
664 Attr : aliased Attributed_Character;
665 Col : aliased C_Short;
666 Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
667 System.Null_Address);
669 if Res = Curses_Ok then
672 raise Curses_Exception;
674 end Get_Character_Attribute;
676 function Get_Character_Attribute (Win : Window := Standard_Window)
679 function Wattrget (Win : Window;
680 Atr : access Attributed_Character;
681 Col : access C_Short;
682 Opt : System.Address) return C_Int;
683 pragma Import (C, Wattrget, "wattr_get");
685 Attr : aliased Attributed_Character;
686 Col : aliased C_Short;
687 Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
688 System.Null_Address);
690 if Res = Curses_Ok then
693 raise Curses_Exception;
695 end Get_Character_Attribute;
697 procedure Set_Color (Win : Window := Standard_Window;
700 function Wset_Color (Win : Window;
702 Opts : C_Void_Ptr) return C_Int;
703 pragma Import (C, Wset_Color, "wcolor_set");
707 C_Void_Ptr (System.Null_Address)) = Curses_Err
709 raise Curses_Exception;
713 procedure Change_Attributes
714 (Win : Window := Standard_Window;
715 Count : Integer := -1;
716 Attr : Character_Attribute_Set := Normal_Video;
717 Color : Color_Pair := Color_Pair'First)
719 function Wchgat (Win : Window;
721 Attr : Attributed_Character;
723 Opts : System.Address := System.Null_Address)
725 pragma Import (C, Wchgat, "wchgat");
729 (Ch => Character'First,
730 Color => Color_Pair'First,
732 C_Short (Color)) = Curses_Err
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)))
943 raise Curses_Exception;
945 end Set_Escape_Timer_Mode;
947 ------------------------------------------------------------------------------
948 procedure Set_NL_Mode (SwitchOn : Boolean := True)
950 function NL return C_Int;
951 pragma Import (C, NL, "nl");
952 function NoNL return C_Int;
953 pragma Import (C, NoNL, "nonl");
962 if Err = Curses_Err then
963 raise Curses_Exception;
967 procedure Clear_On_Next_Update
968 (Win : Window := Standard_Window;
969 Do_Clear : Boolean := True)
971 function Clear_Ok (W : Window; Flag : Curses_Bool) return C_Int;
972 pragma Import (C, Clear_Ok, "clearok");
974 if Clear_Ok (Win, Curses_Bool (Boolean'Pos (Do_Clear))) = Curses_Err then
975 raise Curses_Exception;
977 end Clear_On_Next_Update;
979 procedure Use_Insert_Delete_Line
980 (Win : Window := Standard_Window;
981 Do_Idl : Boolean := True)
983 function IDL_Ok (W : Window; Flag : Curses_Bool) return C_Int;
984 pragma Import (C, IDL_Ok, "idlok");
986 if IDL_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idl))) = Curses_Err then
987 raise Curses_Exception;
989 end Use_Insert_Delete_Line;
991 procedure Use_Insert_Delete_Character
992 (Win : Window := Standard_Window;
993 Do_Idc : Boolean := True)
995 procedure IDC_Ok (W : Window; Flag : Curses_Bool);
996 pragma Import (C, IDC_Ok, "idcok");
998 IDC_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idc)));
999 end Use_Insert_Delete_Character;
1001 procedure Leave_Cursor_After_Update
1002 (Win : Window := Standard_Window;
1003 Do_Leave : Boolean := True)
1005 function Leave_Ok (W : Window; Flag : Curses_Bool) return C_Int;
1006 pragma Import (C, Leave_Ok, "leaveok");
1008 if Leave_Ok (Win, Curses_Bool (Boolean'Pos (Do_Leave))) = Curses_Err then
1009 raise Curses_Exception;
1011 end Leave_Cursor_After_Update;
1013 procedure Immediate_Update_Mode
1014 (Win : Window := Standard_Window;
1015 Mode : Boolean := False)
1017 procedure Immedok (Win : Window; Mode : Curses_Bool);
1018 pragma Import (C, Immedok, "immedok");
1020 Immedok (Win, Curses_Bool (Boolean'Pos (Mode)));
1021 end Immediate_Update_Mode;
1023 procedure Allow_Scrolling
1024 (Win : Window := Standard_Window;
1025 Mode : Boolean := False)
1027 function Scrollok (Win : Window; Mode : Curses_Bool) return C_Int;
1028 pragma Import (C, Scrollok, "scrollok");
1030 if Scrollok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
1031 raise Curses_Exception;
1033 end Allow_Scrolling;
1035 function Scrolling_Allowed (Win : Window := Standard_Window)
1038 function Is_Scroll_Ok (W : Window) return Curses_Bool;
1039 pragma Import (C, Is_Scroll_Ok, "is_scrollok");
1041 return (Is_Scroll_Ok (Win) /= Curses_Bool_False);
1042 end Scrolling_Allowed;
1044 procedure Set_Scroll_Region
1045 (Win : Window := Standard_Window;
1046 Top_Line : Line_Position;
1047 Bottom_Line : Line_Position)
1049 function Wsetscrreg (Win : Window;
1051 Col : C_Int) return C_Int;
1052 pragma Import (C, Wsetscrreg, "wsetscrreg");
1054 if Wsetscrreg (Win, C_Int (Top_Line), C_Int (Bottom_Line))
1057 raise Curses_Exception;
1059 end Set_Scroll_Region;
1060 ------------------------------------------------------------------------------
1061 procedure Update_Screen
1063 function Do_Update return C_Int;
1064 pragma Import (C, Do_Update, "doupdate");
1066 if Do_Update = Curses_Err then
1067 raise Curses_Exception;
1071 procedure Refresh (Win : Window := Standard_Window)
1073 function Wrefresh (W : Window) return C_Int;
1074 pragma Import (C, Wrefresh, "wrefresh");
1076 if Wrefresh (Win) = Curses_Err then
1077 raise Curses_Exception;
1081 procedure Refresh_Without_Update
1082 (Win : Window := Standard_Window)
1084 function Wnoutrefresh (W : Window) return C_Int;
1085 pragma Import (C, Wnoutrefresh, "wnoutrefresh");
1087 if Wnoutrefresh (Win) = Curses_Err then
1088 raise Curses_Exception;
1090 end Refresh_Without_Update;
1092 procedure Redraw (Win : Window := Standard_Window)
1094 function Redrawwin (Win : Window) return C_Int;
1095 pragma Import (C, Redrawwin, "redrawwin");
1097 if Redrawwin (Win) = Curses_Err then
1098 raise Curses_Exception;
1103 (Win : Window := Standard_Window;
1104 Begin_Line : Line_Position;
1105 Line_Count : Positive)
1107 function Wredrawln (Win : Window; First : C_Int; Cnt : C_Int)
1109 pragma Import (C, Wredrawln, "wredrawln");
1113 C_Int (Line_Count)) = Curses_Err
1115 raise Curses_Exception;
1119 ------------------------------------------------------------------------------
1120 procedure Erase (Win : Window := Standard_Window)
1122 function Werase (W : Window) return C_Int;
1123 pragma Import (C, Werase, "werase");
1125 if Werase (Win) = Curses_Err then
1126 raise Curses_Exception;
1130 procedure Clear (Win : Window := Standard_Window)
1132 function Wclear (W : Window) return C_Int;
1133 pragma Import (C, Wclear, "wclear");
1135 if Wclear (Win) = Curses_Err then
1136 raise Curses_Exception;
1140 procedure Clear_To_End_Of_Screen (Win : Window := Standard_Window)
1142 function Wclearbot (W : Window) return C_Int;
1143 pragma Import (C, Wclearbot, "wclrtobot");
1145 if Wclearbot (Win) = Curses_Err then
1146 raise Curses_Exception;
1148 end Clear_To_End_Of_Screen;
1150 procedure Clear_To_End_Of_Line (Win : Window := Standard_Window)
1152 function Wcleareol (W : Window) return C_Int;
1153 pragma Import (C, Wcleareol, "wclrtoeol");
1155 if Wcleareol (Win) = Curses_Err then
1156 raise Curses_Exception;
1158 end Clear_To_End_Of_Line;
1159 ------------------------------------------------------------------------------
1160 procedure Set_Background
1161 (Win : Window := Standard_Window;
1162 Ch : Attributed_Character)
1164 procedure WBackground (W : Window; Ch : Attributed_Character);
1165 pragma Import (C, WBackground, "wbkgdset");
1167 WBackground (Win, Ch);
1170 procedure Change_Background
1171 (Win : Window := Standard_Window;
1172 Ch : Attributed_Character)
1174 function WChangeBkgd (W : Window; Ch : Attributed_Character)
1176 pragma Import (C, WChangeBkgd, "wbkgd");
1178 if WChangeBkgd (Win, Ch) = Curses_Err then
1179 raise Curses_Exception;
1181 end Change_Background;
1183 function Get_Background (Win : Window := Standard_Window)
1184 return Attributed_Character
1186 function Wgetbkgd (Win : Window) return Attributed_Character;
1187 pragma Import (C, Wgetbkgd, "getbkgd");
1189 return Wgetbkgd (Win);
1191 ------------------------------------------------------------------------------
1192 procedure Change_Lines_Status (Win : Window := Standard_Window;
1193 Start : Line_Position;
1197 function Wtouchln (Win : Window;
1200 Chg : C_Int) return C_Int;
1201 pragma Import (C, Wtouchln, "wtouchln");
1203 if Wtouchln (Win, C_Int (Start), C_Int (Count),
1204 C_Int (Boolean'Pos (State))) = Curses_Err
1206 raise Curses_Exception;
1208 end Change_Lines_Status;
1210 procedure Touch (Win : Window := Standard_Window)
1213 X : Column_Position;
1215 Get_Size (Win, Y, X);
1216 pragma Warnings (Off, X); -- unreferenced
1217 Change_Lines_Status (Win, 0, Positive (Y), True);
1220 procedure Untouch (Win : Window := Standard_Window)
1223 X : Column_Position;
1225 Get_Size (Win, Y, X);
1226 pragma Warnings (Off, X); -- unreferenced
1227 Change_Lines_Status (Win, 0, Positive (Y), False);
1230 procedure Touch (Win : Window := Standard_Window;
1231 Start : Line_Position;
1235 Change_Lines_Status (Win, Start, Count, True);
1239 (Win : Window := Standard_Window;
1240 Line : Line_Position) return Boolean
1242 function WLineTouched (W : Window; L : C_Int) return Curses_Bool;
1243 pragma Import (C, WLineTouched, "is_linetouched");
1245 if WLineTouched (Win, C_Int (Line)) = Curses_Bool_False then
1253 (Win : Window := Standard_Window) return Boolean
1255 function WWinTouched (W : Window) return Curses_Bool;
1256 pragma Import (C, WWinTouched, "is_wintouched");
1258 if WWinTouched (Win) = Curses_Bool_False then
1264 ------------------------------------------------------------------------------
1266 (Source_Window : Window;
1267 Destination_Window : Window;
1268 Source_Top_Row : Line_Position;
1269 Source_Left_Column : Column_Position;
1270 Destination_Top_Row : Line_Position;
1271 Destination_Left_Column : Column_Position;
1272 Destination_Bottom_Row : Line_Position;
1273 Destination_Right_Column : Column_Position;
1274 Non_Destructive_Mode : Boolean := True)
1276 function Copywin (Src : Window;
1284 Ndm : C_Int) return C_Int;
1285 pragma Import (C, Copywin, "copywin");
1287 if Copywin (Source_Window,
1289 C_Int (Source_Top_Row),
1290 C_Int (Source_Left_Column),
1291 C_Int (Destination_Top_Row),
1292 C_Int (Destination_Left_Column),
1293 C_Int (Destination_Bottom_Row),
1294 C_Int (Destination_Right_Column),
1295 Boolean'Pos (Non_Destructive_Mode)
1298 raise Curses_Exception;
1303 (Source_Window : Window;
1304 Destination_Window : Window)
1306 function Overwrite (Src : Window; Dst : Window) return C_Int;
1307 pragma Import (C, Overwrite, "overwrite");
1309 if Overwrite (Source_Window, Destination_Window) = Curses_Err then
1310 raise Curses_Exception;
1315 (Source_Window : Window;
1316 Destination_Window : Window)
1318 function Overlay (Src : Window; Dst : Window) return C_Int;
1319 pragma Import (C, Overlay, "overlay");
1321 if Overlay (Source_Window, Destination_Window) = Curses_Err then
1322 raise Curses_Exception;
1326 ------------------------------------------------------------------------------
1327 procedure Insert_Delete_Lines
1328 (Win : Window := Standard_Window;
1329 Lines : Integer := 1) -- default is to insert one line above
1331 function Winsdelln (W : Window; N : C_Int) return C_Int;
1332 pragma Import (C, Winsdelln, "winsdelln");
1334 if Winsdelln (Win, C_Int (Lines)) = Curses_Err then
1335 raise Curses_Exception;
1337 end Insert_Delete_Lines;
1339 procedure Delete_Line (Win : Window := Standard_Window)
1342 Insert_Delete_Lines (Win, -1);
1345 procedure Insert_Line (Win : Window := Standard_Window)
1348 Insert_Delete_Lines (Win, 1);
1350 ------------------------------------------------------------------------------
1353 (Win : Window := Standard_Window;
1354 Number_Of_Lines : out Line_Count;
1355 Number_Of_Columns : out Column_Count)
1357 function GetMaxY (W : Window) return C_Int;
1358 pragma Import (C, GetMaxY, "getmaxy");
1360 function GetMaxX (W : Window) return C_Int;
1361 pragma Import (C, GetMaxX, "getmaxx");
1363 Y : constant C_Int := GetMaxY (Win);
1364 X : constant C_Int := GetMaxX (Win);
1366 Number_Of_Lines := Line_Count (Y);
1367 Number_Of_Columns := Column_Count (X);
1370 procedure Get_Window_Position
1371 (Win : Window := Standard_Window;
1372 Top_Left_Line : out Line_Position;
1373 Top_Left_Column : out Column_Position)
1375 function GetBegY (W : Window) return C_Int;
1376 pragma Import (C, GetBegY, "getbegy");
1378 function GetBegX (W : Window) return C_Int;
1379 pragma Import (C, GetBegX, "getbegx");
1381 Y : constant C_Short := C_Short (GetBegY (Win));
1382 X : constant C_Short := C_Short (GetBegX (Win));
1384 Top_Left_Line := Line_Position (Y);
1385 Top_Left_Column := Column_Position (X);
1386 end Get_Window_Position;
1388 procedure Get_Cursor_Position
1389 (Win : Window := Standard_Window;
1390 Line : out Line_Position;
1391 Column : out Column_Position)
1393 function GetCurY (W : Window) return C_Int;
1394 pragma Import (C, GetCurY, "getcury");
1396 function GetCurX (W : Window) return C_Int;
1397 pragma Import (C, GetCurX, "getcurx");
1399 Y : constant C_Short := C_Short (GetCurY (Win));
1400 X : constant C_Short := C_Short (GetCurX (Win));
1402 Line := Line_Position (Y);
1403 Column := Column_Position (X);
1404 end Get_Cursor_Position;
1406 procedure Get_Origin_Relative_To_Parent
1408 Top_Left_Line : out Line_Position;
1409 Top_Left_Column : out Column_Position;
1410 Is_Not_A_Subwindow : out Boolean)
1412 function GetParY (W : Window) return C_Int;
1413 pragma Import (C, GetParY, "getpary");
1415 function GetParX (W : Window) return C_Int;
1416 pragma Import (C, GetParX, "getparx");
1418 Y : constant C_Int := GetParY (Win);
1419 X : constant C_Int := GetParX (Win);
1422 Top_Left_Line := Line_Position'Last;
1423 Top_Left_Column := Column_Position'Last;
1424 Is_Not_A_Subwindow := True;
1426 Top_Left_Line := Line_Position (Y);
1427 Top_Left_Column := Column_Position (X);
1428 Is_Not_A_Subwindow := False;
1430 end Get_Origin_Relative_To_Parent;
1431 ------------------------------------------------------------------------------
1432 function New_Pad (Lines : Line_Count;
1433 Columns : Column_Count) return Window
1435 function Newpad (Lines : C_Int; Columns : C_Int) return Window;
1436 pragma Import (C, Newpad, "newpad");
1440 W := Newpad (C_Int (Lines), C_Int (Columns));
1441 if W = Null_Window then
1442 raise Curses_Exception;
1449 Number_Of_Lines : Line_Count;
1450 Number_Of_Columns : Column_Count;
1451 First_Line_Position : Line_Position;
1452 First_Column_Position : Column_Position) return Window
1456 Number_Of_Lines : C_Int;
1457 Number_Of_Columns : C_Int;
1458 First_Line_Position : C_Int;
1459 First_Column_Position : C_Int) return Window;
1460 pragma Import (C, Subpad, "subpad");
1465 C_Int (Number_Of_Lines),
1466 C_Int (Number_Of_Columns),
1467 C_Int (First_Line_Position),
1468 C_Int (First_Column_Position));
1469 if W = Null_Window then
1470 raise Curses_Exception;
1477 Source_Top_Row : Line_Position;
1478 Source_Left_Column : Column_Position;
1479 Destination_Top_Row : Line_Position;
1480 Destination_Left_Column : Column_Position;
1481 Destination_Bottom_Row : Line_Position;
1482 Destination_Right_Column : Column_Position)
1486 Source_Top_Row : C_Int;
1487 Source_Left_Column : C_Int;
1488 Destination_Top_Row : C_Int;
1489 Destination_Left_Column : C_Int;
1490 Destination_Bottom_Row : C_Int;
1491 Destination_Right_Column : C_Int) return C_Int;
1492 pragma Import (C, Prefresh, "prefresh");
1495 C_Int (Source_Top_Row),
1496 C_Int (Source_Left_Column),
1497 C_Int (Destination_Top_Row),
1498 C_Int (Destination_Left_Column),
1499 C_Int (Destination_Bottom_Row),
1500 C_Int (Destination_Right_Column)) = Curses_Err
1502 raise Curses_Exception;
1506 procedure Refresh_Without_Update
1508 Source_Top_Row : Line_Position;
1509 Source_Left_Column : Column_Position;
1510 Destination_Top_Row : Line_Position;
1511 Destination_Left_Column : Column_Position;
1512 Destination_Bottom_Row : Line_Position;
1513 Destination_Right_Column : Column_Position)
1515 function Pnoutrefresh
1517 Source_Top_Row : C_Int;
1518 Source_Left_Column : C_Int;
1519 Destination_Top_Row : C_Int;
1520 Destination_Left_Column : C_Int;
1521 Destination_Bottom_Row : C_Int;
1522 Destination_Right_Column : C_Int) return C_Int;
1523 pragma Import (C, Pnoutrefresh, "pnoutrefresh");
1525 if Pnoutrefresh (Pad,
1526 C_Int (Source_Top_Row),
1527 C_Int (Source_Left_Column),
1528 C_Int (Destination_Top_Row),
1529 C_Int (Destination_Left_Column),
1530 C_Int (Destination_Bottom_Row),
1531 C_Int (Destination_Right_Column)) = Curses_Err
1533 raise Curses_Exception;
1535 end Refresh_Without_Update;
1537 procedure Add_Character_To_Pad_And_Echo_It
1539 Ch : Attributed_Character)
1541 function Pechochar (Pad : Window; Ch : Attributed_Character)
1543 pragma Import (C, Pechochar, "pechochar");
1545 if Pechochar (Pad, Ch) = Curses_Err then
1546 raise Curses_Exception;
1548 end Add_Character_To_Pad_And_Echo_It;
1550 procedure Add_Character_To_Pad_And_Echo_It
1555 Add_Character_To_Pad_And_Echo_It
1557 Attributed_Character'(Ch => Ch,
1558 Color => Color_Pair'First,
1559 Attr => Normal_Video));
1560 end Add_Character_To_Pad_And_Echo_It;
1561 ------------------------------------------------------------------------------
1562 procedure Scroll (Win : Window := Standard_Window;
1563 Amount : Integer := 1)
1565 function Wscrl (Win : Window; N : C_Int) return C_Int;
1566 pragma Import (C, Wscrl, "wscrl");
1569 if Wscrl (Win, C_Int (Amount)) = Curses_Err then
1570 raise Curses_Exception;
1574 ------------------------------------------------------------------------------
1575 procedure Delete_Character (Win : Window := Standard_Window)
1577 function Wdelch (Win : Window) return C_Int;
1578 pragma Import (C, Wdelch, "wdelch");
1580 if Wdelch (Win) = Curses_Err then
1581 raise Curses_Exception;
1583 end Delete_Character;
1585 procedure Delete_Character
1586 (Win : Window := Standard_Window;
1587 Line : Line_Position;
1588 Column : Column_Position)
1590 function Mvwdelch (Win : Window;
1592 Col : C_Int) return C_Int;
1593 pragma Import (C, Mvwdelch, "mvwdelch");
1595 if Mvwdelch (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
1596 raise Curses_Exception;
1598 end Delete_Character;
1599 ------------------------------------------------------------------------------
1600 function Peek (Win : Window := Standard_Window)
1601 return Attributed_Character
1603 function Winch (Win : Window) return Attributed_Character;
1604 pragma Import (C, Winch, "winch");
1610 (Win : Window := Standard_Window;
1611 Line : Line_Position;
1612 Column : Column_Position) return Attributed_Character
1614 function Mvwinch (Win : Window;
1616 Col : C_Int) return Attributed_Character;
1617 pragma Import (C, Mvwinch, "mvwinch");
1619 return Mvwinch (Win, C_Int (Line), C_Int (Column));
1621 ------------------------------------------------------------------------------
1622 procedure Insert (Win : Window := Standard_Window;
1623 Ch : Attributed_Character)
1625 function Winsch (Win : Window; Ch : Attributed_Character) return C_Int;
1626 pragma Import (C, Winsch, "winsch");
1628 if Winsch (Win, Ch) = Curses_Err then
1629 raise Curses_Exception;
1634 (Win : Window := Standard_Window;
1635 Line : Line_Position;
1636 Column : Column_Position;
1637 Ch : Attributed_Character)
1639 function Mvwinsch (Win : Window;
1642 Ch : Attributed_Character) return C_Int;
1643 pragma Import (C, Mvwinsch, "mvwinsch");
1650 raise Curses_Exception;
1653 ------------------------------------------------------------------------------
1654 procedure Insert (Win : Window := Standard_Window;
1656 Len : Integer := -1)
1658 function Winsnstr (Win : Window;
1660 Len : Integer := -1) return C_Int;
1661 pragma Import (C, Winsnstr, "winsnstr");
1663 Txt : char_array (0 .. Str'Length);
1666 To_C (Str, Txt, Length);
1667 if Winsnstr (Win, Txt, Len) = Curses_Err then
1668 raise Curses_Exception;
1673 (Win : Window := Standard_Window;
1674 Line : Line_Position;
1675 Column : Column_Position;
1677 Len : Integer := -1)
1679 function Mvwinsnstr (Win : Window;
1683 Len : C_Int) return C_Int;
1684 pragma Import (C, Mvwinsnstr, "mvwinsnstr");
1686 Txt : char_array (0 .. Str'Length);
1689 To_C (Str, Txt, Length);
1690 if Mvwinsnstr (Win, C_Int (Line), C_Int (Column), Txt, C_Int (Len))
1693 raise Curses_Exception;
1696 ------------------------------------------------------------------------------
1697 procedure Peek (Win : Window := Standard_Window;
1699 Len : Integer := -1)
1701 function Winnstr (Win : Window;
1703 Len : C_Int) return C_Int;
1704 pragma Import (C, Winnstr, "winnstr");
1707 Txt : char_array (0 .. Str'Length);
1713 if N > Str'Length then
1714 raise Constraint_Error;
1716 Txt (0) := Interfaces.C.char'First;
1717 if Winnstr (Win, Txt, C_Int (N)) = Curses_Err then
1718 raise Curses_Exception;
1720 To_Ada (Txt, Str, Cnt, True);
1721 if Cnt < Str'Length then
1722 Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
1727 (Win : Window := Standard_Window;
1728 Line : Line_Position;
1729 Column : Column_Position;
1731 Len : Integer := -1)
1734 Move_Cursor (Win, Line, Column);
1735 Peek (Win, Str, Len);
1737 ------------------------------------------------------------------------------
1739 (Win : Window := Standard_Window;
1740 Str : out Attributed_String;
1741 Len : Integer := -1)
1743 function Winchnstr (Win : Window;
1744 Str : chtype_array; -- out
1745 Len : C_Int) return C_Int;
1746 pragma Import (C, Winchnstr, "winchnstr");
1749 Txt : constant chtype_array (0 .. Str'Length)
1750 := (0 => Default_Character);
1756 if N > Str'Length then
1757 raise Constraint_Error;
1759 if Winchnstr (Win, Txt, C_Int (N)) = Curses_Err then
1760 raise Curses_Exception;
1762 for To in Str'Range loop
1763 exit when Txt (size_t (Cnt)) = Default_Character;
1764 Str (To) := Txt (size_t (Cnt));
1767 if Cnt < Str'Length then
1768 Str ((Str'First + Cnt) .. Str'Last) :=
1769 (others => (Ch => ' ',
1770 Color => Color_Pair'First,
1771 Attr => Normal_Video));
1776 (Win : Window := Standard_Window;
1777 Line : Line_Position;
1778 Column : Column_Position;
1779 Str : out Attributed_String;
1780 Len : Integer := -1)
1783 Move_Cursor (Win, Line, Column);
1784 Peek (Win, Str, Len);
1786 ------------------------------------------------------------------------------
1787 procedure Get (Win : Window := Standard_Window;
1789 Len : Integer := -1)
1791 function Wgetnstr (Win : Window;
1793 Len : C_Int) return C_Int;
1794 pragma Import (C, Wgetnstr, "wgetnstr");
1797 Txt : char_array (0 .. Str'Length);
1803 if N > Str'Length then
1804 raise Constraint_Error;
1806 Txt (0) := Interfaces.C.char'First;
1807 if Wgetnstr (Win, Txt, C_Int (N)) = Curses_Err then
1808 raise Curses_Exception;
1810 To_Ada (Txt, Str, Cnt, True);
1811 if Cnt < Str'Length then
1812 Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
1817 (Win : Window := Standard_Window;
1818 Line : Line_Position;
1819 Column : Column_Position;
1821 Len : Integer := -1)
1824 Move_Cursor (Win, Line, Column);
1825 Get (Win, Str, Len);
1827 ------------------------------------------------------------------------------
1828 procedure Init_Soft_Label_Keys
1829 (Format : Soft_Label_Key_Format := Three_Two_Three)
1831 function Slk_Init (Fmt : C_Int) return C_Int;
1832 pragma Import (C, Slk_Init, "slk_init");
1834 if Slk_Init (Soft_Label_Key_Format'Pos (Format)) = Curses_Err then
1835 raise Curses_Exception;
1837 end Init_Soft_Label_Keys;
1839 procedure Set_Soft_Label_Key (Label : Label_Number;
1841 Fmt : Label_Justification := Left)
1843 function Slk_Set (Label : C_Int;
1845 Fmt : C_Int) return C_Int;
1846 pragma Import (C, Slk_Set, "slk_set");
1848 Txt : char_array (0 .. Text'Length);
1851 To_C (Text, Txt, Len);
1852 if Slk_Set (C_Int (Label), Txt,
1853 C_Int (Label_Justification'Pos (Fmt))) = Curses_Err
1855 raise Curses_Exception;
1857 end Set_Soft_Label_Key;
1859 procedure Refresh_Soft_Label_Keys
1861 function Slk_Refresh return C_Int;
1862 pragma Import (C, Slk_Refresh, "slk_refresh");
1864 if Slk_Refresh = Curses_Err then
1865 raise Curses_Exception;
1867 end Refresh_Soft_Label_Keys;
1869 procedure Refresh_Soft_Label_Keys_Without_Update
1871 function Slk_Noutrefresh return C_Int;
1872 pragma Import (C, Slk_Noutrefresh, "slk_noutrefresh");
1874 if Slk_Noutrefresh = Curses_Err then
1875 raise Curses_Exception;
1877 end Refresh_Soft_Label_Keys_Without_Update;
1879 procedure Get_Soft_Label_Key (Label : Label_Number;
1882 function Slk_Label (Label : C_Int) return chars_ptr;
1883 pragma Import (C, Slk_Label, "slk_label");
1885 Fill_String (Slk_Label (C_Int (Label)), Text);
1886 end Get_Soft_Label_Key;
1888 function Get_Soft_Label_Key (Label : Label_Number) return String
1890 function Slk_Label (Label : C_Int) return chars_ptr;
1891 pragma Import (C, Slk_Label, "slk_label");
1893 return Fill_String (Slk_Label (C_Int (Label)));
1894 end Get_Soft_Label_Key;
1896 procedure Clear_Soft_Label_Keys
1898 function Slk_Clear return C_Int;
1899 pragma Import (C, Slk_Clear, "slk_clear");
1901 if Slk_Clear = Curses_Err then
1902 raise Curses_Exception;
1904 end Clear_Soft_Label_Keys;
1906 procedure Restore_Soft_Label_Keys
1908 function Slk_Restore return C_Int;
1909 pragma Import (C, Slk_Restore, "slk_restore");
1911 if Slk_Restore = Curses_Err then
1912 raise Curses_Exception;
1914 end Restore_Soft_Label_Keys;
1916 procedure Touch_Soft_Label_Keys
1918 function Slk_Touch return C_Int;
1919 pragma Import (C, Slk_Touch, "slk_touch");
1921 if Slk_Touch = Curses_Err then
1922 raise Curses_Exception;
1924 end Touch_Soft_Label_Keys;
1926 procedure Switch_Soft_Label_Key_Attributes
1927 (Attr : Character_Attribute_Set;
1928 On : Boolean := True)
1930 function Slk_Attron (Ch : Attributed_Character) return C_Int;
1931 pragma Import (C, Slk_Attron, "slk_attron");
1932 function Slk_Attroff (Ch : Attributed_Character) return C_Int;
1933 pragma Import (C, Slk_Attroff, "slk_attroff");
1936 Ch : constant Attributed_Character := (Ch => Character'First,
1938 Color => Color_Pair'First);
1941 Err := Slk_Attron (Ch);
1943 Err := Slk_Attroff (Ch);
1945 if Err = Curses_Err then
1946 raise Curses_Exception;
1948 end Switch_Soft_Label_Key_Attributes;
1950 procedure Set_Soft_Label_Key_Attributes
1951 (Attr : Character_Attribute_Set := Normal_Video;
1952 Color : Color_Pair := Color_Pair'First)
1954 function Slk_Attrset (Ch : Attributed_Character) return C_Int;
1955 pragma Import (C, Slk_Attrset, "slk_attrset");
1957 Ch : constant Attributed_Character := (Ch => Character'First,
1961 if Slk_Attrset (Ch) = Curses_Err then
1962 raise Curses_Exception;
1964 end Set_Soft_Label_Key_Attributes;
1966 function Get_Soft_Label_Key_Attributes return Character_Attribute_Set
1968 function Slk_Attr return Attributed_Character;
1969 pragma Import (C, Slk_Attr, "slk_attr");
1971 Attr : constant Attributed_Character := Slk_Attr;
1974 end Get_Soft_Label_Key_Attributes;
1976 function Get_Soft_Label_Key_Attributes return Color_Pair
1978 function Slk_Attr return Attributed_Character;
1979 pragma Import (C, Slk_Attr, "slk_attr");
1981 Attr : constant Attributed_Character := Slk_Attr;
1984 end Get_Soft_Label_Key_Attributes;
1986 procedure Set_Soft_Label_Key_Color (Pair : Color_Pair)
1988 function Slk_Color (Color : C_Short) return C_Int;
1989 pragma Import (C, Slk_Color, "slk_color");
1991 if Slk_Color (C_Short (Pair)) = Curses_Err then
1992 raise Curses_Exception;
1994 end Set_Soft_Label_Key_Color;
1996 ------------------------------------------------------------------------------
1997 procedure Enable_Key (Key : Special_Key_Code;
1998 Enable : Boolean := True)
2000 function Keyok (Keycode : C_Int;
2001 On_Off : Curses_Bool) return C_Int;
2002 pragma Import (C, Keyok, "keyok");
2004 if Keyok (C_Int (Key), Curses_Bool (Boolean'Pos (Enable)))
2007 raise Curses_Exception;
2010 ------------------------------------------------------------------------------
2011 procedure Define_Key (Definition : String;
2012 Key : Special_Key_Code)
2014 function Defkey (Def : char_array;
2015 Key : C_Int) return C_Int;
2016 pragma Import (C, Defkey, "define_key");
2018 Txt : char_array (0 .. Definition'Length);
2021 To_C (Definition, Txt, Length);
2022 if Defkey (Txt, C_Int (Key)) = Curses_Err then
2023 raise Curses_Exception;
2026 ------------------------------------------------------------------------------
2027 procedure Un_Control (Ch : Attributed_Character;
2030 function Unctrl (Ch : Attributed_Character) return chars_ptr;
2031 pragma Import (C, Unctrl, "unctrl");
2033 Fill_String (Unctrl (Ch), Str);
2036 function Un_Control (Ch : Attributed_Character) return String
2038 function Unctrl (Ch : Attributed_Character) return chars_ptr;
2039 pragma Import (C, Unctrl, "unctrl");
2041 return Fill_String (Unctrl (Ch));
2044 procedure Delay_Output (Msecs : Natural)
2046 function Delayoutput (Msecs : C_Int) return C_Int;
2047 pragma Import (C, Delayoutput, "delay_output");
2049 if Delayoutput (C_Int (Msecs)) = Curses_Err then
2050 raise Curses_Exception;
2054 procedure Flush_Input
2056 function Flushinp return C_Int;
2057 pragma Import (C, Flushinp, "flushinp");
2059 if Flushinp = Curses_Err then -- docu says that never happens, but...
2060 raise Curses_Exception;
2063 ------------------------------------------------------------------------------
2064 function Baudrate return Natural
2066 function Baud return C_Int;
2067 pragma Import (C, Baud, "baudrate");
2069 return Natural (Baud);
2072 function Erase_Character return Character
2074 function Erasechar return C_Int;
2075 pragma Import (C, Erasechar, "erasechar");
2077 return Character'Val (Erasechar);
2078 end Erase_Character;
2080 function Kill_Character return Character
2082 function Killchar return C_Int;
2083 pragma Import (C, Killchar, "killchar");
2085 return Character'Val (Killchar);
2088 function Has_Insert_Character return Boolean
2090 function Has_Ic return Curses_Bool;
2091 pragma Import (C, Has_Ic, "has_ic");
2093 if Has_Ic = Curses_Bool_False then
2098 end Has_Insert_Character;
2100 function Has_Insert_Line return Boolean
2102 function Has_Il return Curses_Bool;
2103 pragma Import (C, Has_Il, "has_il");
2105 if Has_Il = Curses_Bool_False then
2110 end Has_Insert_Line;
2112 function Supported_Attributes return Character_Attribute_Set
2114 function Termattrs return Attributed_Character;
2115 pragma Import (C, Termattrs, "termattrs");
2117 Ch : constant Attributed_Character := Termattrs;
2120 end Supported_Attributes;
2122 procedure Long_Name (Name : out String)
2124 function Longname return chars_ptr;
2125 pragma Import (C, Longname, "longname");
2127 Fill_String (Longname, Name);
2130 function Long_Name return String
2132 function Longname return chars_ptr;
2133 pragma Import (C, Longname, "longname");
2135 return Fill_String (Longname);
2138 procedure Terminal_Name (Name : out String)
2140 function Termname return chars_ptr;
2141 pragma Import (C, Termname, "termname");
2143 Fill_String (Termname, Name);
2146 function Terminal_Name return String
2148 function Termname return chars_ptr;
2149 pragma Import (C, Termname, "termname");
2151 return Fill_String (Termname);
2153 ------------------------------------------------------------------------------
2154 procedure Init_Pair (Pair : Redefinable_Color_Pair;
2155 Fore : Color_Number;
2156 Back : Color_Number)
2158 function Initpair (Pair : C_Short;
2160 Back : C_Short) return C_Int;
2161 pragma Import (C, Initpair, "init_pair");
2163 if Integer (Pair) >= Number_Of_Color_Pairs then
2164 raise Constraint_Error;
2166 if Integer (Fore) >= Number_Of_Colors or else
2167 Integer (Back) >= Number_Of_Colors
2169 raise Constraint_Error;
2171 if Initpair (C_Short (Pair), C_Short (Fore), C_Short (Back))
2174 raise Curses_Exception;
2178 procedure Pair_Content (Pair : Color_Pair;
2179 Fore : out Color_Number;
2180 Back : out Color_Number)
2182 type C_Short_Access is access all C_Short;
2183 function Paircontent (Pair : C_Short;
2184 Fp : C_Short_Access;
2185 Bp : C_Short_Access) return C_Int;
2186 pragma Import (C, Paircontent, "pair_content");
2188 F, B : aliased C_Short;
2190 if Paircontent (C_Short (Pair), F'Access, B'Access) = Curses_Err then
2191 raise Curses_Exception;
2193 Fore := Color_Number (F);
2194 Back := Color_Number (B);
2198 function Has_Colors return Boolean
2200 function Hascolors return Curses_Bool;
2201 pragma Import (C, Hascolors, "has_colors");
2203 if Hascolors = Curses_Bool_False then
2210 procedure Init_Color (Color : Color_Number;
2215 function Initcolor (Col : C_Short;
2218 Blue : C_Short) return C_Int;
2219 pragma Import (C, Initcolor, "init_color");
2221 if Initcolor (C_Short (Color), C_Short (Red), C_Short (Green),
2222 C_Short (Blue)) = Curses_Err
2224 raise Curses_Exception;
2228 function Can_Change_Color return Boolean
2230 function Canchangecolor return Curses_Bool;
2231 pragma Import (C, Canchangecolor, "can_change_color");
2233 if Canchangecolor = Curses_Bool_False then
2238 end Can_Change_Color;
2240 procedure Color_Content (Color : Color_Number;
2241 Red : out RGB_Value;
2242 Green : out RGB_Value;
2243 Blue : out RGB_Value)
2245 type C_Short_Access is access all C_Short;
2247 function Colorcontent (Color : C_Short; R, G, B : C_Short_Access)
2249 pragma Import (C, Colorcontent, "color_content");
2251 R, G, B : aliased C_Short;
2253 if Colorcontent (C_Short (Color), R'Access, G'Access, B'Access) =
2256 raise Curses_Exception;
2258 Red := RGB_Value (R);
2259 Green := RGB_Value (G);
2260 Blue := RGB_Value (B);
2264 ------------------------------------------------------------------------------
2265 procedure Save_Curses_Mode (Mode : Curses_Mode)
2267 function Def_Prog_Mode return C_Int;
2268 pragma Import (C, Def_Prog_Mode, "def_prog_mode");
2269 function Def_Shell_Mode return C_Int;
2270 pragma Import (C, Def_Shell_Mode, "def_shell_mode");
2275 when Curses => Err := Def_Prog_Mode;
2276 when Shell => Err := Def_Shell_Mode;
2278 if Err = Curses_Err then
2279 raise Curses_Exception;
2281 end Save_Curses_Mode;
2283 procedure Reset_Curses_Mode (Mode : Curses_Mode)
2285 function Reset_Prog_Mode return C_Int;
2286 pragma Import (C, Reset_Prog_Mode, "reset_prog_mode");
2287 function Reset_Shell_Mode return C_Int;
2288 pragma Import (C, Reset_Shell_Mode, "reset_shell_mode");
2293 when Curses => Err := Reset_Prog_Mode;
2294 when Shell => Err := Reset_Shell_Mode;
2296 if Err = Curses_Err then
2297 raise Curses_Exception;
2299 end Reset_Curses_Mode;
2301 procedure Save_Terminal_State
2303 function Savetty return C_Int;
2304 pragma Import (C, Savetty, "savetty");
2306 if Savetty = Curses_Err then
2307 raise Curses_Exception;
2309 end Save_Terminal_State;
2311 procedure Reset_Terminal_State
2313 function Resetty return C_Int;
2314 pragma Import (C, Resetty, "resetty");
2316 if Resetty = Curses_Err then
2317 raise Curses_Exception;
2319 end Reset_Terminal_State;
2321 procedure Rip_Off_Lines (Lines : Integer;
2322 Proc : Stdscr_Init_Proc)
2324 function Ripoffline (Lines : C_Int;
2325 Proc : Stdscr_Init_Proc) return C_Int;
2326 pragma Import (C, Ripoffline, "_nc_ripoffline");
2328 if Ripoffline (C_Int (Lines), Proc) = Curses_Err then
2329 raise Curses_Exception;
2333 procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility)
2335 function Curs_Set (Curs : C_Int) return C_Int;
2336 pragma Import (C, Curs_Set, "curs_set");
2340 Res := Curs_Set (Cursor_Visibility'Pos (Visibility));
2341 if Res /= Curses_Err then
2342 Visibility := Cursor_Visibility'Val (Res);
2344 end Set_Cursor_Visibility;
2346 procedure Nap_Milli_Seconds (Ms : Natural)
2348 function Napms (Ms : C_Int) return C_Int;
2349 pragma Import (C, Napms, "napms");
2351 if Napms (C_Int (Ms)) = Curses_Err then
2352 raise Curses_Exception;
2354 end Nap_Milli_Seconds;
2355 ------------------------------------------------------------------------------
2356 function Lines return Line_Count
2358 function LINES_As_Function return Interfaces.C.int;
2359 pragma Import (C, LINES_As_Function, "LINES_as_function");
2361 return Line_Count (LINES_As_Function);
2364 function Columns return Column_Count
2366 function COLS_As_Function return Interfaces.C.int;
2367 pragma Import (C, COLS_As_Function, "COLS_as_function");
2369 return Column_Count (COLS_As_Function);
2372 function Tab_Size return Natural
2374 function TABSIZE_As_Function return Interfaces.C.int;
2375 pragma Import (C, TABSIZE_As_Function, "TABSIZE_as_function");
2378 return Natural (TABSIZE_As_Function);
2381 function Number_Of_Colors return Natural
2383 function COLORS_As_Function return Interfaces.C.int;
2384 pragma Import (C, COLORS_As_Function, "COLORS_as_function");
2386 return Natural (COLORS_As_Function);
2387 end Number_Of_Colors;
2389 function Number_Of_Color_Pairs return Natural
2391 function COLOR_PAIRS_As_Function return Interfaces.C.int;
2392 pragma Import (C, COLOR_PAIRS_As_Function, "COLOR_PAIRS_as_function");
2394 return Natural (COLOR_PAIRS_As_Function);
2395 end Number_Of_Color_Pairs;
2396 ------------------------------------------------------------------------------
2397 procedure Transform_Coordinates
2398 (W : Window := Standard_Window;
2399 Line : in out Line_Position;
2400 Column : in out Column_Position;
2401 Dir : Transform_Direction := From_Screen)
2403 type Int_Access is access all C_Int;
2404 function Transform (W : Window;
2406 Dir : Curses_Bool) return C_Int;
2407 pragma Import (C, Transform, "wmouse_trafo");
2409 X : aliased C_Int := C_Int (Column);
2410 Y : aliased C_Int := C_Int (Line);
2411 D : Curses_Bool := Curses_Bool_False;
2414 if Dir = To_Screen then
2417 R := Transform (W, Y'Access, X'Access, D);
2418 if R = Curses_False then
2419 raise Curses_Exception;
2421 Line := Line_Position (Y);
2422 Column := Column_Position (X);
2424 end Transform_Coordinates;
2425 ------------------------------------------------------------------------------
2426 procedure Use_Default_Colors is
2427 function C_Use_Default_Colors return C_Int;
2428 pragma Import (C, C_Use_Default_Colors, "use_default_colors");
2429 Err : constant C_Int := C_Use_Default_Colors;
2431 if Err = Curses_Err then
2432 raise Curses_Exception;
2434 end Use_Default_Colors;
2436 procedure Assume_Default_Colors (Fore : Color_Number := Default_Color;
2437 Back : Color_Number := Default_Color)
2439 function C_Assume_Default_Colors (Fore : C_Int;
2440 Back : C_Int) return C_Int;
2441 pragma Import (C, C_Assume_Default_Colors, "assume_default_colors");
2443 Err : constant C_Int := C_Assume_Default_Colors (C_Int (Fore),
2446 if Err = Curses_Err then
2447 raise Curses_Exception;
2449 end Assume_Default_Colors;
2450 ------------------------------------------------------------------------------
2451 function Curses_Version return String
2453 function curses_versionC return chars_ptr;
2454 pragma Import (C, curses_versionC, "curses_version");
2455 Result : constant chars_ptr := curses_versionC;
2457 return Fill_String (Result);
2459 ------------------------------------------------------------------------------
2460 procedure Curses_Free_All is
2461 procedure curses_freeall;
2462 pragma Import (C, curses_freeall, "_nc_freeall");
2464 -- Use this only for testing: you cannot use curses after calling it,
2465 -- so it has to be the "last" thing done before exiting the program.
2466 -- This will not really free ALL of memory used by curses. That is
2467 -- because it cannot free the memory used for stdout's setbuf. The
2468 -- _nc_free_and_exit() procedure can do that, but it can be invoked
2469 -- safely only from C - and again, that only as the "last" thing done
2470 -- before exiting the program.
2472 end Curses_Free_All;
2473 ------------------------------------------------------------------------------
2474 function Use_Extended_Names (Enable : Boolean) return Boolean
2476 function use_extended_namesC (e : Curses_Bool) return C_Int;
2477 pragma Import (C, use_extended_namesC, "use_extended_names");
2479 Res : constant C_Int :=
2480 use_extended_namesC (Curses_Bool (Boolean'Pos (Enable)));
2482 if Res = C_Int (Curses_Bool_False) then
2487 end Use_Extended_Names;
2488 ------------------------------------------------------------------------------
2489 procedure Screen_Dump_To_File (Filename : String)
2491 function scr_dump (f : char_array) return C_Int;
2492 pragma Import (C, scr_dump, "scr_dump");
2493 Txt : char_array (0 .. Filename'Length);
2496 To_C (Filename, Txt, Length);
2497 if Curses_Err = scr_dump (Txt) then
2498 raise Curses_Exception;
2500 end Screen_Dump_To_File;
2502 procedure Screen_Restore_From_File (Filename : String)
2504 function scr_restore (f : char_array) return C_Int;
2505 pragma Import (C, scr_restore, "scr_restore");
2506 Txt : char_array (0 .. Filename'Length);
2509 To_C (Filename, Txt, Length);
2510 if Curses_Err = scr_restore (Txt) then
2511 raise Curses_Exception;
2513 end Screen_Restore_From_File;
2515 procedure Screen_Init_From_File (Filename : String)
2517 function scr_init (f : char_array) return C_Int;
2518 pragma Import (C, scr_init, "scr_init");
2519 Txt : char_array (0 .. Filename'Length);
2522 To_C (Filename, Txt, Length);
2523 if Curses_Err = scr_init (Txt) then
2524 raise Curses_Exception;
2526 end Screen_Init_From_File;
2528 procedure Screen_Set_File (Filename : String)
2530 function scr_set (f : char_array) return C_Int;
2531 pragma Import (C, scr_set, "scr_set");
2532 Txt : char_array (0 .. Filename'Length);
2535 To_C (Filename, Txt, Length);
2536 if Curses_Err = scr_set (Txt) then
2537 raise Curses_Exception;
2539 end Screen_Set_File;
2540 ------------------------------------------------------------------------------
2541 procedure Resize (Win : Window := Standard_Window;
2542 Number_Of_Lines : Line_Count;
2543 Number_Of_Columns : Column_Count) is
2544 function wresize (win : Window;
2546 columns : C_Int) return C_Int;
2547 pragma Import (C, wresize);
2550 C_Int (Number_Of_Lines),
2551 C_Int (Number_Of_Columns)) = Curses_Err
2553 raise Curses_Exception;
2556 ------------------------------------------------------------------------------
2558 end Terminal_Interface.Curses;