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-2006,2007 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: 2007/03/31 23:02:22 $
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 : in 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 : in 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 : in Window := Standard_Window;
136 Line : in Line_Position;
137 Column : in 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 : in Window := Standard_Window;
151 Ch : in Attributed_Character)
153 function Waddch (W : Window;
154 Ch : C_Chtype) return C_Int;
155 pragma Import (C, Waddch, "waddch");
157 if Waddch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
158 raise Curses_Exception;
162 procedure Add (Win : in Window := Standard_Window;
167 Attributed_Character'(Ch => Ch,
168 Color => Color_Pair'First,
169 Attr => Normal_Video));
173 (Win : in Window := Standard_Window;
174 Line : in Line_Position;
175 Column : in Column_Position;
176 Ch : in Attributed_Character)
178 function mvwaddch (W : Window;
181 Ch : C_Chtype) return C_Int;
182 pragma Import (C, mvwaddch, "mvwaddch");
184 if mvwaddch (Win, C_Int (Line),
186 AttrChar_To_Chtype (Ch)) = Curses_Err then
187 raise Curses_Exception;
192 (Win : in Window := Standard_Window;
193 Line : in Line_Position;
194 Column : in Column_Position;
201 Attributed_Character'(Ch => Ch,
202 Color => Color_Pair'First,
203 Attr => Normal_Video));
206 procedure Add_With_Immediate_Echo
207 (Win : in Window := Standard_Window;
208 Ch : in Attributed_Character)
210 function Wechochar (W : Window;
211 Ch : C_Chtype) return C_Int;
212 pragma Import (C, Wechochar, "wechochar");
214 if Wechochar (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
215 raise Curses_Exception;
217 end Add_With_Immediate_Echo;
219 procedure Add_With_Immediate_Echo
220 (Win : in 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 : in Window;
335 Line : in Line_Position;
336 Column : in 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 : in Window;
349 Line : in Line_Position;
350 Column : in 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 : in Window := Standard_Window;
363 Mode : in 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 : in Window := Standard_Window;
376 Len : in Integer := -1)
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 : in Window := Standard_Window;
394 Line : in Line_Position;
395 Column : in Column_Position;
397 Len : in Integer := -1)
400 Move_Cursor (Win, Line, Column);
403 ------------------------------------------------------------------------------
405 (Win : in Window := Standard_Window;
406 Str : in Attributed_String;
407 Len : in Integer := -1)
409 function Waddchnstr (Win : Window;
411 Len : C_Int := -1) return C_Int;
412 pragma Import (C, Waddchnstr, "waddchnstr");
414 Txt : chtype_array (0 .. Str'Length);
416 for Length in 1 .. size_t (Str'Length) loop
417 Txt (Length - 1) := Str (Natural (Length));
419 Txt (Str'Length) := Default_Character;
422 C_Int (Len)) = Curses_Err then
423 raise Curses_Exception;
428 (Win : in Window := Standard_Window;
429 Line : in Line_Position;
430 Column : in Column_Position;
431 Str : in Attributed_String;
432 Len : in Integer := -1)
435 Move_Cursor (Win, Line, Column);
438 ------------------------------------------------------------------------------
440 (Win : in Window := Standard_Window;
441 Left_Side_Symbol : in Attributed_Character := Default_Character;
442 Right_Side_Symbol : in Attributed_Character := Default_Character;
443 Top_Side_Symbol : in Attributed_Character := Default_Character;
444 Bottom_Side_Symbol : in Attributed_Character := Default_Character;
445 Upper_Left_Corner_Symbol : in Attributed_Character := Default_Character;
446 Upper_Right_Corner_Symbol : in Attributed_Character := Default_Character;
447 Lower_Left_Corner_Symbol : in Attributed_Character := Default_Character;
448 Lower_Right_Corner_Symbol : in Attributed_Character := Default_Character)
450 function Wborder (W : Window;
458 LRC : C_Chtype) return C_Int;
459 pragma Import (C, Wborder, "wborder");
462 AttrChar_To_Chtype (Left_Side_Symbol),
463 AttrChar_To_Chtype (Right_Side_Symbol),
464 AttrChar_To_Chtype (Top_Side_Symbol),
465 AttrChar_To_Chtype (Bottom_Side_Symbol),
466 AttrChar_To_Chtype (Upper_Left_Corner_Symbol),
467 AttrChar_To_Chtype (Upper_Right_Corner_Symbol),
468 AttrChar_To_Chtype (Lower_Left_Corner_Symbol),
469 AttrChar_To_Chtype (Lower_Right_Corner_Symbol)
472 raise Curses_Exception;
477 (Win : in Window := Standard_Window;
478 Vertical_Symbol : in Attributed_Character := Default_Character;
479 Horizontal_Symbol : in Attributed_Character := Default_Character)
483 Vertical_Symbol, Vertical_Symbol,
484 Horizontal_Symbol, Horizontal_Symbol);
487 procedure Horizontal_Line
488 (Win : in Window := Standard_Window;
489 Line_Size : in Natural;
490 Line_Symbol : in Attributed_Character := Default_Character)
492 function Whline (W : Window;
494 Len : C_Int) return C_Int;
495 pragma Import (C, Whline, "whline");
498 AttrChar_To_Chtype (Line_Symbol),
499 C_Int (Line_Size)) = Curses_Err then
500 raise Curses_Exception;
504 procedure Vertical_Line
505 (Win : in Window := Standard_Window;
506 Line_Size : in Natural;
507 Line_Symbol : in Attributed_Character := Default_Character)
509 function Wvline (W : Window;
511 Len : C_Int) return C_Int;
512 pragma Import (C, Wvline, "wvline");
515 AttrChar_To_Chtype (Line_Symbol),
516 C_Int (Line_Size)) = Curses_Err then
517 raise Curses_Exception;
521 ------------------------------------------------------------------------------
522 function Get_Keystroke (Win : Window := Standard_Window)
525 function Wgetch (W : Window) return C_Int;
526 pragma Import (C, Wgetch, "wgetch");
528 C : constant C_Int := Wgetch (Win);
530 if C = Curses_Err then
533 return Real_Key_Code (C);
537 procedure Undo_Keystroke (Key : in Real_Key_Code)
539 function Ungetch (Ch : C_Int) return C_Int;
540 pragma Import (C, Ungetch, "ungetch");
542 if Ungetch (C_Int (Key)) = Curses_Err then
543 raise Curses_Exception;
547 function Has_Key (Key : Special_Key_Code) return Boolean
549 function Haskey (Key : C_Int) return C_Int;
550 pragma Import (C, Haskey, "has_key");
552 if Haskey (C_Int (Key)) = Curses_False then
559 function Is_Function_Key (Key : Special_Key_Code) return Boolean
561 L : constant Special_Key_Code := Special_Key_Code (Natural (Key_F0) +
562 Natural (Function_Key_Number'Last));
564 if (Key >= Key_F0) and then (Key <= L) then
571 function Function_Key (Key : Real_Key_Code)
572 return Function_Key_Number
575 if Is_Function_Key (Key) then
576 return Function_Key_Number (Key - Key_F0);
578 raise Constraint_Error;
582 function Function_Key_Code (Key : Function_Key_Number) return Real_Key_Code
585 return Real_Key_Code (Natural (Key_F0) + Natural (Key));
586 end Function_Key_Code;
587 ------------------------------------------------------------------------------
588 procedure Standout (Win : Window := Standard_Window;
589 On : Boolean := True)
591 function wstandout (Win : Window) return C_Int;
592 pragma Import (C, wstandout, "wstandout");
593 function wstandend (Win : Window) return C_Int;
594 pragma Import (C, wstandend, "wstandend");
599 Err := wstandout (Win);
601 Err := wstandend (Win);
603 if Err = Curses_Err then
604 raise Curses_Exception;
608 procedure Switch_Character_Attribute
609 (Win : in Window := Standard_Window;
610 Attr : in Character_Attribute_Set := Normal_Video;
611 On : in Boolean := True)
613 function Wattron (Win : Window;
614 C_Attr : C_AttrType) return C_Int;
615 pragma Import (C, Wattron, "wattr_on");
616 function Wattroff (Win : Window;
617 C_Attr : C_AttrType) return C_Int;
618 pragma Import (C, Wattroff, "wattr_off");
619 -- In Ada we use the On Boolean to control whether or not we want to
620 -- switch on or off the attributes in the set.
622 AC : constant Attributed_Character := (Ch => Character'First,
623 Color => Color_Pair'First,
627 Err := Wattron (Win, AttrChar_To_AttrType (AC));
629 Err := Wattroff (Win, AttrChar_To_AttrType (AC));
631 if Err = Curses_Err then
632 raise Curses_Exception;
634 end Switch_Character_Attribute;
636 procedure Set_Character_Attributes
637 (Win : in Window := Standard_Window;
638 Attr : in Character_Attribute_Set := Normal_Video;
639 Color : in Color_Pair := Color_Pair'First)
641 function Wattrset (Win : Window;
642 C_Attr : C_AttrType) return C_Int;
643 pragma Import (C, Wattrset, "wattrset"); -- ??? wattr_set
646 AttrChar_To_AttrType (Attributed_Character'
647 (Ch => Character'First,
649 Attr => Attr))) = Curses_Err then
650 raise Curses_Exception;
652 end Set_Character_Attributes;
654 function Get_Character_Attribute (Win : Window := Standard_Window)
655 return Character_Attribute_Set
657 function Wattrget (Win : Window;
658 Atr : access C_AttrType;
659 Col : access C_Short;
660 Opt : System.Address) return C_Int;
661 pragma Import (C, Wattrget, "wattr_get");
663 Attr : aliased C_AttrType;
664 Col : aliased C_Short;
665 Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
666 System.Null_Address);
667 Ch : Attributed_Character;
669 if Res = Curses_Ok then
670 Ch := AttrType_To_AttrChar (Attr);
673 raise Curses_Exception;
675 end Get_Character_Attribute;
677 function Get_Character_Attribute (Win : Window := Standard_Window)
680 function Wattrget (Win : Window;
681 Atr : access C_AttrType;
682 Col : access C_Short;
683 Opt : System.Address) return C_Int;
684 pragma Import (C, Wattrget, "wattr_get");
686 Attr : aliased C_AttrType;
687 Col : aliased C_Short;
688 Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
689 System.Null_Address);
690 Ch : Attributed_Character;
692 if Res = Curses_Ok then
693 Ch := AttrType_To_AttrChar (Attr);
696 raise Curses_Exception;
698 end Get_Character_Attribute;
700 procedure Set_Color (Win : in Window := Standard_Window;
701 Pair : in Color_Pair)
703 function Wset_Color (Win : Window;
705 Opts : C_Void_Ptr) return C_Int;
706 pragma Import (C, Wset_Color, "wcolor_set");
710 C_Void_Ptr (System.Null_Address)) = Curses_Err then
711 raise Curses_Exception;
715 procedure Change_Attributes
716 (Win : in Window := Standard_Window;
717 Count : in Integer := -1;
718 Attr : in Character_Attribute_Set := Normal_Video;
719 Color : in Color_Pair := Color_Pair'First)
721 function Wchgat (Win : Window;
725 Opts : System.Address := System.Null_Address)
727 pragma Import (C, Wchgat, "wchgat");
729 Ch : constant Attributed_Character :=
730 (Ch => Character'First, Color => Color_Pair'First, Attr => Attr);
732 if Wchgat (Win, C_Int (Count), AttrChar_To_AttrType (Ch),
733 C_Short (Color)) = Curses_Err then
734 raise Curses_Exception;
736 end Change_Attributes;
738 procedure Change_Attributes
739 (Win : in Window := Standard_Window;
740 Line : in Line_Position := Line_Position'First;
741 Column : in Column_Position := Column_Position'First;
742 Count : in Integer := -1;
743 Attr : in Character_Attribute_Set := Normal_Video;
744 Color : in 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 : in 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 : in 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 : in 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 : in Window := Standard_Window;
829 SwitchOn : in 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 : in Window := Standard_Window;
840 SwitchOn : in 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 : in 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 : in 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 : in Window := Standard_Window;
871 Mode : in 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 : in Window := Standard_Window;
883 Flush : in 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 : in Window := Standard_Window;
902 Mode : in 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 : in Window := Standard_Window;
913 Mode : in Timeout_Mode;
916 function Wtimeout (Win : Window; Amount : C_Int) return 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 if Wtimeout (Win, Time) = Curses_Err then
931 raise Curses_Exception;
933 end Set_Timeout_Mode;
935 procedure Set_Escape_Timer_Mode
936 (Win : in Window := Standard_Window;
937 Timer_Off : in Boolean := False)
939 function Notimeout (Win : Window; Mode : Curses_Bool) return C_Int;
940 pragma Import (C, Notimeout, "notimeout");
942 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 : in 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 : in Window := Standard_Window;
970 Do_Clear : in 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 : in Window := Standard_Window;
982 Do_Idl : in 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 : in Window := Standard_Window;
994 Do_Idc : in Boolean := True)
996 function IDC_Ok (W : Window; Flag : Curses_Bool) return C_Int;
997 pragma Import (C, IDC_Ok, "idcok");
999 if IDC_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idc))) = Curses_Err then
1000 raise Curses_Exception;
1002 end Use_Insert_Delete_Character;
1004 procedure Leave_Cursor_After_Update
1005 (Win : in Window := Standard_Window;
1006 Do_Leave : in Boolean := True)
1008 function Leave_Ok (W : Window; Flag : Curses_Bool) return C_Int;
1009 pragma Import (C, Leave_Ok, "leaveok");
1011 if Leave_Ok (Win, Curses_Bool (Boolean'Pos (Do_Leave))) = Curses_Err then
1012 raise Curses_Exception;
1014 end Leave_Cursor_After_Update;
1016 procedure Immediate_Update_Mode
1017 (Win : in Window := Standard_Window;
1018 Mode : in Boolean := False)
1020 function Immedok (Win : Window; Mode : Curses_Bool) return C_Int;
1021 pragma Import (C, Immedok, "immedok");
1023 if Immedok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
1024 raise Curses_Exception;
1026 end Immediate_Update_Mode;
1028 procedure Allow_Scrolling
1029 (Win : in Window := Standard_Window;
1030 Mode : in Boolean := False)
1032 function Scrollok (Win : Window; Mode : Curses_Bool) return C_Int;
1033 pragma Import (C, Scrollok, "scrollok");
1035 if Scrollok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
1036 raise Curses_Exception;
1038 end Allow_Scrolling;
1040 function Scrolling_Allowed (Win : Window := Standard_Window)
1043 function Is_Scroll_Ok (W : Window) return Curses_Bool;
1044 pragma Import (C, Is_Scroll_Ok, "is_scrollok");
1046 return (Is_Scroll_Ok (Win) /= Curses_Bool_False);
1047 end Scrolling_Allowed;
1049 procedure Set_Scroll_Region
1050 (Win : in Window := Standard_Window;
1051 Top_Line : in Line_Position;
1052 Bottom_Line : in Line_Position)
1054 function Wsetscrreg (Win : Window;
1056 Col : C_Int) return C_Int;
1057 pragma Import (C, Wsetscrreg, "wsetscrreg");
1059 if Wsetscrreg (Win, C_Int (Top_Line), C_Int (Bottom_Line))
1061 raise Curses_Exception;
1063 end Set_Scroll_Region;
1064 ------------------------------------------------------------------------------
1065 procedure Update_Screen
1067 function Do_Update return C_Int;
1068 pragma Import (C, Do_Update, "doupdate");
1070 if Do_Update = Curses_Err then
1071 raise Curses_Exception;
1075 procedure Refresh (Win : in Window := Standard_Window)
1077 function Wrefresh (W : Window) return C_Int;
1078 pragma Import (C, Wrefresh, "wrefresh");
1080 if Wrefresh (Win) = Curses_Err then
1081 raise Curses_Exception;
1085 procedure Refresh_Without_Update
1086 (Win : in Window := Standard_Window)
1088 function Wnoutrefresh (W : Window) return C_Int;
1089 pragma Import (C, Wnoutrefresh, "wnoutrefresh");
1091 if Wnoutrefresh (Win) = Curses_Err then
1092 raise Curses_Exception;
1094 end Refresh_Without_Update;
1096 procedure Redraw (Win : in Window := Standard_Window)
1098 function Redrawwin (Win : Window) return C_Int;
1099 pragma Import (C, Redrawwin, "redrawwin");
1101 if Redrawwin (Win) = Curses_Err then
1102 raise Curses_Exception;
1107 (Win : in Window := Standard_Window;
1108 Begin_Line : in Line_Position;
1109 Line_Count : in Positive)
1111 function Wredrawln (Win : Window; First : C_Int; Cnt : C_Int)
1113 pragma Import (C, Wredrawln, "wredrawln");
1117 C_Int (Line_Count)) = Curses_Err then
1118 raise Curses_Exception;
1122 ------------------------------------------------------------------------------
1123 procedure Erase (Win : in Window := Standard_Window)
1125 function Werase (W : Window) return C_Int;
1126 pragma Import (C, Werase, "werase");
1128 if Werase (Win) = Curses_Err then
1129 raise Curses_Exception;
1133 procedure Clear (Win : in Window := Standard_Window)
1135 function Wclear (W : Window) return C_Int;
1136 pragma Import (C, Wclear, "wclear");
1138 if Wclear (Win) = Curses_Err then
1139 raise Curses_Exception;
1143 procedure Clear_To_End_Of_Screen (Win : in Window := Standard_Window)
1145 function Wclearbot (W : Window) return C_Int;
1146 pragma Import (C, Wclearbot, "wclrtobot");
1148 if Wclearbot (Win) = Curses_Err then
1149 raise Curses_Exception;
1151 end Clear_To_End_Of_Screen;
1153 procedure Clear_To_End_Of_Line (Win : in Window := Standard_Window)
1155 function Wcleareol (W : Window) return C_Int;
1156 pragma Import (C, Wcleareol, "wclrtoeol");
1158 if Wcleareol (Win) = Curses_Err then
1159 raise Curses_Exception;
1161 end Clear_To_End_Of_Line;
1162 ------------------------------------------------------------------------------
1163 procedure Set_Background
1164 (Win : in Window := Standard_Window;
1165 Ch : in Attributed_Character)
1167 procedure WBackground (W : in Window; Ch : in C_Chtype);
1168 pragma Import (C, WBackground, "wbkgdset");
1170 WBackground (Win, AttrChar_To_Chtype (Ch));
1173 procedure Change_Background
1174 (Win : in Window := Standard_Window;
1175 Ch : in Attributed_Character)
1177 function WChangeBkgd (W : Window; Ch : C_Chtype) return C_Int;
1178 pragma Import (C, WChangeBkgd, "wbkgd");
1180 if WChangeBkgd (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
1181 raise Curses_Exception;
1183 end Change_Background;
1185 function Get_Background (Win : Window := Standard_Window)
1186 return Attributed_Character
1188 function Wgetbkgd (Win : Window) return C_Chtype;
1189 pragma Import (C, Wgetbkgd, "getbkgd");
1191 return Chtype_To_AttrChar (Wgetbkgd (Win));
1193 ------------------------------------------------------------------------------
1194 procedure Change_Lines_Status (Win : in Window := Standard_Window;
1195 Start : in Line_Position;
1196 Count : in Positive;
1199 function Wtouchln (Win : Window;
1202 Chg : C_Int) return C_Int;
1203 pragma Import (C, Wtouchln, "wtouchln");
1205 if Wtouchln (Win, C_Int (Start), C_Int (Count),
1206 C_Int (Boolean'Pos (State))) = Curses_Err then
1207 raise Curses_Exception;
1209 end Change_Lines_Status;
1211 procedure Touch (Win : in Window := Standard_Window)
1214 X : Column_Position;
1216 Get_Size (Win, Y, X);
1217 Change_Lines_Status (Win, 0, Positive (Y), True);
1220 procedure Untouch (Win : in Window := Standard_Window)
1223 X : Column_Position;
1225 Get_Size (Win, Y, X);
1226 Change_Lines_Status (Win, 0, Positive (Y), False);
1229 procedure Touch (Win : in Window := Standard_Window;
1230 Start : in Line_Position;
1231 Count : in Positive)
1234 Change_Lines_Status (Win, Start, Count, True);
1238 (Win : Window := Standard_Window;
1239 Line : Line_Position) return Boolean
1241 function WLineTouched (W : Window; L : C_Int) return Curses_Bool;
1242 pragma Import (C, WLineTouched, "is_linetouched");
1244 if WLineTouched (Win, C_Int (Line)) = Curses_Bool_False then
1252 (Win : Window := Standard_Window) return Boolean
1254 function WWinTouched (W : Window) return Curses_Bool;
1255 pragma Import (C, WWinTouched, "is_wintouched");
1257 if WWinTouched (Win) = Curses_Bool_False then
1263 ------------------------------------------------------------------------------
1265 (Source_Window : in Window;
1266 Destination_Window : in Window;
1267 Source_Top_Row : in Line_Position;
1268 Source_Left_Column : in Column_Position;
1269 Destination_Top_Row : in Line_Position;
1270 Destination_Left_Column : in Column_Position;
1271 Destination_Bottom_Row : in Line_Position;
1272 Destination_Right_Column : in Column_Position;
1273 Non_Destructive_Mode : in Boolean := True)
1275 function Copywin (Src : Window;
1283 Ndm : C_Int) return C_Int;
1284 pragma Import (C, Copywin, "copywin");
1286 if Copywin (Source_Window,
1288 C_Int (Source_Top_Row),
1289 C_Int (Source_Left_Column),
1290 C_Int (Destination_Top_Row),
1291 C_Int (Destination_Left_Column),
1292 C_Int (Destination_Bottom_Row),
1293 C_Int (Destination_Right_Column),
1294 Boolean'Pos (Non_Destructive_Mode)
1296 raise Curses_Exception;
1301 (Source_Window : in Window;
1302 Destination_Window : in Window)
1304 function Overwrite (Src : Window; Dst : Window) return C_Int;
1305 pragma Import (C, Overwrite, "overwrite");
1307 if Overwrite (Source_Window, Destination_Window) = Curses_Err then
1308 raise Curses_Exception;
1313 (Source_Window : in Window;
1314 Destination_Window : in Window)
1316 function Overlay (Src : Window; Dst : Window) return C_Int;
1317 pragma Import (C, Overlay, "overlay");
1319 if Overlay (Source_Window, Destination_Window) = Curses_Err then
1320 raise Curses_Exception;
1324 ------------------------------------------------------------------------------
1325 procedure Insert_Delete_Lines
1326 (Win : in Window := Standard_Window;
1327 Lines : in Integer := 1) -- default is to insert one line above
1329 function Winsdelln (W : Window; N : C_Int) return C_Int;
1330 pragma Import (C, Winsdelln, "winsdelln");
1332 if Winsdelln (Win, C_Int (Lines)) = Curses_Err then
1333 raise Curses_Exception;
1335 end Insert_Delete_Lines;
1337 procedure Delete_Line (Win : in Window := Standard_Window)
1340 Insert_Delete_Lines (Win, -1);
1343 procedure Insert_Line (Win : in Window := Standard_Window)
1346 Insert_Delete_Lines (Win, 1);
1348 ------------------------------------------------------------------------------
1351 (Win : in Window := Standard_Window;
1352 Number_Of_Lines : out Line_Count;
1353 Number_Of_Columns : out Column_Count)
1355 function GetMaxY (W : Window) return C_Int;
1356 pragma Import (C, GetMaxY, "getmaxy");
1358 function GetMaxX (W : Window) return C_Int;
1359 pragma Import (C, GetMaxX, "getmaxx");
1361 Y : constant C_Int := GetMaxY (Win)
1362 + C_Int (Offset_XY);
1363 X : constant C_Int := GetMaxX (Win)
1364 + C_Int (Offset_XY);
1366 Number_Of_Lines := Line_Count (Y);
1367 Number_Of_Columns := Column_Count (X);
1370 procedure Get_Window_Position
1371 (Win : in 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 : in 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 : in Line_Position;
1478 Source_Left_Column : in Column_Position;
1479 Destination_Top_Row : in Line_Position;
1480 Destination_Left_Column : in Column_Position;
1481 Destination_Bottom_Row : in Line_Position;
1482 Destination_Right_Column : in 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 then
1501 raise Curses_Exception;
1505 procedure Refresh_Without_Update
1507 Source_Top_Row : in Line_Position;
1508 Source_Left_Column : in Column_Position;
1509 Destination_Top_Row : in Line_Position;
1510 Destination_Left_Column : in Column_Position;
1511 Destination_Bottom_Row : in Line_Position;
1512 Destination_Right_Column : in Column_Position)
1514 function Pnoutrefresh
1516 Source_Top_Row : C_Int;
1517 Source_Left_Column : C_Int;
1518 Destination_Top_Row : C_Int;
1519 Destination_Left_Column : C_Int;
1520 Destination_Bottom_Row : C_Int;
1521 Destination_Right_Column : C_Int) return C_Int;
1522 pragma Import (C, Pnoutrefresh, "pnoutrefresh");
1524 if Pnoutrefresh (Pad,
1525 C_Int (Source_Top_Row),
1526 C_Int (Source_Left_Column),
1527 C_Int (Destination_Top_Row),
1528 C_Int (Destination_Left_Column),
1529 C_Int (Destination_Bottom_Row),
1530 C_Int (Destination_Right_Column)) = Curses_Err then
1531 raise Curses_Exception;
1533 end Refresh_Without_Update;
1535 procedure Add_Character_To_Pad_And_Echo_It
1537 Ch : in Attributed_Character)
1539 function Pechochar (Pad : Window; Ch : C_Chtype)
1541 pragma Import (C, Pechochar, "pechochar");
1543 if Pechochar (Pad, AttrChar_To_Chtype (Ch)) = Curses_Err then
1544 raise Curses_Exception;
1546 end Add_Character_To_Pad_And_Echo_It;
1548 procedure Add_Character_To_Pad_And_Echo_It
1553 Add_Character_To_Pad_And_Echo_It
1555 Attributed_Character'(Ch => Ch,
1556 Color => Color_Pair'First,
1557 Attr => Normal_Video));
1558 end Add_Character_To_Pad_And_Echo_It;
1559 ------------------------------------------------------------------------------
1560 procedure Scroll (Win : in Window := Standard_Window;
1561 Amount : in Integer := 1)
1563 function Wscrl (Win : Window; N : C_Int) return C_Int;
1564 pragma Import (C, Wscrl, "wscrl");
1567 if Wscrl (Win, C_Int (Amount)) = Curses_Err then
1568 raise Curses_Exception;
1572 ------------------------------------------------------------------------------
1573 procedure Delete_Character (Win : in Window := Standard_Window)
1575 function Wdelch (Win : Window) return C_Int;
1576 pragma Import (C, Wdelch, "wdelch");
1578 if Wdelch (Win) = Curses_Err then
1579 raise Curses_Exception;
1581 end Delete_Character;
1583 procedure Delete_Character
1584 (Win : in Window := Standard_Window;
1585 Line : in Line_Position;
1586 Column : in Column_Position)
1588 function Mvwdelch (Win : Window;
1590 Col : C_Int) return C_Int;
1591 pragma Import (C, Mvwdelch, "mvwdelch");
1593 if Mvwdelch (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
1594 raise Curses_Exception;
1596 end Delete_Character;
1597 ------------------------------------------------------------------------------
1598 function Peek (Win : Window := Standard_Window)
1599 return Attributed_Character
1601 function Winch (Win : Window) return C_Chtype;
1602 pragma Import (C, Winch, "winch");
1604 return Chtype_To_AttrChar (Winch (Win));
1608 (Win : Window := Standard_Window;
1609 Line : Line_Position;
1610 Column : Column_Position) return Attributed_Character
1612 function Mvwinch (Win : Window;
1614 Col : C_Int) return C_Chtype;
1615 pragma Import (C, Mvwinch, "mvwinch");
1617 return Chtype_To_AttrChar (Mvwinch (Win, C_Int (Line), C_Int (Column)));
1619 ------------------------------------------------------------------------------
1620 procedure Insert (Win : in Window := Standard_Window;
1621 Ch : in Attributed_Character)
1623 function Winsch (Win : Window; Ch : C_Chtype) return C_Int;
1624 pragma Import (C, Winsch, "winsch");
1626 if Winsch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
1627 raise Curses_Exception;
1632 (Win : in Window := Standard_Window;
1633 Line : in Line_Position;
1634 Column : in Column_Position;
1635 Ch : in Attributed_Character)
1637 function Mvwinsch (Win : Window;
1640 Ch : C_Chtype) return C_Int;
1641 pragma Import (C, Mvwinsch, "mvwinsch");
1646 AttrChar_To_Chtype (Ch)) = Curses_Err then
1647 raise Curses_Exception;
1650 ------------------------------------------------------------------------------
1651 procedure Insert (Win : in Window := Standard_Window;
1653 Len : in Integer := -1)
1655 function Winsnstr (Win : Window;
1657 Len : Integer := -1) return C_Int;
1658 pragma Import (C, Winsnstr, "winsnstr");
1660 Txt : char_array (0 .. Str'Length);
1663 To_C (Str, Txt, Length);
1664 if Winsnstr (Win, Txt, Len) = Curses_Err then
1665 raise Curses_Exception;
1670 (Win : in Window := Standard_Window;
1671 Line : in Line_Position;
1672 Column : in Column_Position;
1674 Len : in Integer := -1)
1676 function Mvwinsnstr (Win : Window;
1680 Len : C_Int) return C_Int;
1681 pragma Import (C, Mvwinsnstr, "mvwinsnstr");
1683 Txt : char_array (0 .. Str'Length);
1686 To_C (Str, Txt, Length);
1687 if Mvwinsnstr (Win, C_Int (Line), C_Int (Column), Txt, C_Int (Len))
1689 raise Curses_Exception;
1692 ------------------------------------------------------------------------------
1693 procedure Peek (Win : in Window := Standard_Window;
1695 Len : in Integer := -1)
1697 function Winnstr (Win : Window;
1699 Len : C_Int) return C_Int;
1700 pragma Import (C, Winnstr, "winnstr");
1703 Txt : char_array (0 .. Str'Length);
1709 if N > Str'Length then
1710 raise Constraint_Error;
1712 Txt (0) := Interfaces.C.char'First;
1713 if Winnstr (Win, Txt, C_Int (N)) = Curses_Err then
1714 raise Curses_Exception;
1716 To_Ada (Txt, Str, Cnt, True);
1717 if Cnt < Str'Length then
1718 Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
1723 (Win : in Window := Standard_Window;
1724 Line : in Line_Position;
1725 Column : in Column_Position;
1727 Len : in Integer := -1)
1730 Move_Cursor (Win, Line, Column);
1731 Peek (Win, Str, Len);
1733 ------------------------------------------------------------------------------
1735 (Win : in Window := Standard_Window;
1736 Str : out Attributed_String;
1737 Len : in Integer := -1)
1739 function Winchnstr (Win : Window;
1740 Str : chtype_array; -- out
1741 Len : C_Int) return C_Int;
1742 pragma Import (C, Winchnstr, "winchnstr");
1745 Txt : constant chtype_array (0 .. Str'Length)
1746 := (0 => Default_Character);
1752 if N > Str'Length then
1753 raise Constraint_Error;
1755 if Winchnstr (Win, Txt, C_Int (N)) = Curses_Err then
1756 raise Curses_Exception;
1758 for To in Str'Range loop
1759 exit when Txt (size_t (Cnt)) = Default_Character;
1760 Str (To) := Txt (size_t (Cnt));
1763 if Cnt < Str'Length then
1764 Str ((Str'First + Cnt) .. Str'Last) :=
1765 (others => (Ch => ' ',
1766 Color => Color_Pair'First,
1767 Attr => Normal_Video));
1772 (Win : in Window := Standard_Window;
1773 Line : in Line_Position;
1774 Column : in Column_Position;
1775 Str : out Attributed_String;
1776 Len : in Integer := -1)
1779 Move_Cursor (Win, Line, Column);
1780 Peek (Win, Str, Len);
1782 ------------------------------------------------------------------------------
1783 procedure Get (Win : in Window := Standard_Window;
1785 Len : in Integer := -1)
1787 function Wgetnstr (Win : Window;
1789 Len : C_Int) return C_Int;
1790 pragma Import (C, Wgetnstr, "wgetnstr");
1793 Txt : char_array (0 .. Str'Length);
1799 if N > Str'Length then
1800 raise Constraint_Error;
1802 Txt (0) := Interfaces.C.char'First;
1803 if Wgetnstr (Win, Txt, C_Int (N)) = Curses_Err then
1804 raise Curses_Exception;
1806 To_Ada (Txt, Str, Cnt, True);
1807 if Cnt < Str'Length then
1808 Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
1813 (Win : in Window := Standard_Window;
1814 Line : in Line_Position;
1815 Column : in Column_Position;
1817 Len : in Integer := -1)
1820 Move_Cursor (Win, Line, Column);
1821 Get (Win, Str, Len);
1823 ------------------------------------------------------------------------------
1824 procedure Init_Soft_Label_Keys
1825 (Format : in Soft_Label_Key_Format := Three_Two_Three)
1827 function Slk_Init (Fmt : C_Int) return C_Int;
1828 pragma Import (C, Slk_Init, "slk_init");
1830 if Slk_Init (Soft_Label_Key_Format'Pos (Format)) = Curses_Err then
1831 raise Curses_Exception;
1833 end Init_Soft_Label_Keys;
1835 procedure Set_Soft_Label_Key (Label : in Label_Number;
1837 Fmt : in Label_Justification := Left)
1839 function Slk_Set (Label : C_Int;
1841 Fmt : C_Int) return C_Int;
1842 pragma Import (C, Slk_Set, "slk_set");
1844 Txt : char_array (0 .. Text'Length);
1847 To_C (Text, Txt, Len);
1848 if Slk_Set (C_Int (Label), Txt,
1849 C_Int (Label_Justification'Pos (Fmt))) = Curses_Err then
1850 raise Curses_Exception;
1852 end Set_Soft_Label_Key;
1854 procedure Refresh_Soft_Label_Keys
1856 function Slk_Refresh return C_Int;
1857 pragma Import (C, Slk_Refresh, "slk_refresh");
1859 if Slk_Refresh = Curses_Err then
1860 raise Curses_Exception;
1862 end Refresh_Soft_Label_Keys;
1864 procedure Refresh_Soft_Label_Keys_Without_Update
1866 function Slk_Noutrefresh return C_Int;
1867 pragma Import (C, Slk_Noutrefresh, "slk_noutrefresh");
1869 if Slk_Noutrefresh = Curses_Err then
1870 raise Curses_Exception;
1872 end Refresh_Soft_Label_Keys_Without_Update;
1874 procedure Get_Soft_Label_Key (Label : in Label_Number;
1877 function Slk_Label (Label : C_Int) return chars_ptr;
1878 pragma Import (C, Slk_Label, "slk_label");
1880 Fill_String (Slk_Label (C_Int (Label)), Text);
1881 end Get_Soft_Label_Key;
1883 function Get_Soft_Label_Key (Label : in Label_Number) return String
1885 function Slk_Label (Label : C_Int) return chars_ptr;
1886 pragma Import (C, Slk_Label, "slk_label");
1888 return Fill_String (Slk_Label (C_Int (Label)));
1889 end Get_Soft_Label_Key;
1891 procedure Clear_Soft_Label_Keys
1893 function Slk_Clear return C_Int;
1894 pragma Import (C, Slk_Clear, "slk_clear");
1896 if Slk_Clear = Curses_Err then
1897 raise Curses_Exception;
1899 end Clear_Soft_Label_Keys;
1901 procedure Restore_Soft_Label_Keys
1903 function Slk_Restore return C_Int;
1904 pragma Import (C, Slk_Restore, "slk_restore");
1906 if Slk_Restore = Curses_Err then
1907 raise Curses_Exception;
1909 end Restore_Soft_Label_Keys;
1911 procedure Touch_Soft_Label_Keys
1913 function Slk_Touch return C_Int;
1914 pragma Import (C, Slk_Touch, "slk_touch");
1916 if Slk_Touch = Curses_Err then
1917 raise Curses_Exception;
1919 end Touch_Soft_Label_Keys;
1921 procedure Switch_Soft_Label_Key_Attributes
1922 (Attr : in Character_Attribute_Set;
1923 On : in Boolean := True)
1925 function Slk_Attron (Ch : C_Chtype) return C_Int;
1926 pragma Import (C, Slk_Attron, "slk_attron");
1927 function Slk_Attroff (Ch : C_Chtype) return C_Int;
1928 pragma Import (C, Slk_Attroff, "slk_attroff");
1931 Ch : constant Attributed_Character := (Ch => Character'First,
1933 Color => Color_Pair'First);
1936 Err := Slk_Attron (AttrChar_To_Chtype (Ch));
1938 Err := Slk_Attroff (AttrChar_To_Chtype (Ch));
1940 if Err = Curses_Err then
1941 raise Curses_Exception;
1943 end Switch_Soft_Label_Key_Attributes;
1945 procedure Set_Soft_Label_Key_Attributes
1946 (Attr : in Character_Attribute_Set := Normal_Video;
1947 Color : in Color_Pair := Color_Pair'First)
1949 function Slk_Attrset (Ch : C_Chtype) return C_Int;
1950 pragma Import (C, Slk_Attrset, "slk_attrset");
1952 Ch : constant Attributed_Character := (Ch => Character'First,
1956 if Slk_Attrset (AttrChar_To_Chtype (Ch)) = Curses_Err then
1957 raise Curses_Exception;
1959 end Set_Soft_Label_Key_Attributes;
1961 function Get_Soft_Label_Key_Attributes return Character_Attribute_Set
1963 function Slk_Attr return C_Chtype;
1964 pragma Import (C, Slk_Attr, "slk_attr");
1966 Attr : constant C_Chtype := Slk_Attr;
1968 return Chtype_To_AttrChar (Attr).Attr;
1969 end Get_Soft_Label_Key_Attributes;
1971 function Get_Soft_Label_Key_Attributes return Color_Pair
1973 function Slk_Attr return C_Chtype;
1974 pragma Import (C, Slk_Attr, "slk_attr");
1976 Attr : constant C_Chtype := Slk_Attr;
1978 return Chtype_To_AttrChar (Attr).Color;
1979 end Get_Soft_Label_Key_Attributes;
1981 procedure Set_Soft_Label_Key_Color (Pair : in Color_Pair)
1983 function Slk_Color (Color : in C_Short) return C_Int;
1984 pragma Import (C, Slk_Color, "slk_color");
1986 if Slk_Color (C_Short (Pair)) = Curses_Err then
1987 raise Curses_Exception;
1989 end Set_Soft_Label_Key_Color;
1991 ------------------------------------------------------------------------------
1992 procedure Enable_Key (Key : in Special_Key_Code;
1993 Enable : in Boolean := True)
1995 function Keyok (Keycode : C_Int;
1996 On_Off : Curses_Bool) return C_Int;
1997 pragma Import (C, Keyok, "keyok");
1999 if Keyok (C_Int (Key), Curses_Bool (Boolean'Pos (Enable)))
2001 raise Curses_Exception;
2004 ------------------------------------------------------------------------------
2005 procedure Define_Key (Definition : in String;
2006 Key : in Special_Key_Code)
2008 function Defkey (Def : char_array;
2009 Key : C_Int) return C_Int;
2010 pragma Import (C, Defkey, "define_key");
2012 Txt : char_array (0 .. Definition'Length);
2015 To_C (Definition, Txt, Length);
2016 if Defkey (Txt, C_Int (Key)) = Curses_Err then
2017 raise Curses_Exception;
2020 ------------------------------------------------------------------------------
2021 procedure Un_Control (Ch : in Attributed_Character;
2024 function Unctrl (Ch : C_Chtype) return chars_ptr;
2025 pragma Import (C, Unctrl, "unctrl");
2027 Fill_String (Unctrl (AttrChar_To_Chtype (Ch)), Str);
2030 function Un_Control (Ch : in Attributed_Character) return String
2032 function Unctrl (Ch : C_Chtype) return chars_ptr;
2033 pragma Import (C, Unctrl, "unctrl");
2035 return Fill_String (Unctrl (AttrChar_To_Chtype (Ch)));
2038 procedure Delay_Output (Msecs : in Natural)
2040 function Delayoutput (Msecs : C_Int) return C_Int;
2041 pragma Import (C, Delayoutput, "delay_output");
2043 if Delayoutput (C_Int (Msecs)) = Curses_Err then
2044 raise Curses_Exception;
2048 procedure Flush_Input
2050 function Flushinp return C_Int;
2051 pragma Import (C, Flushinp, "flushinp");
2053 if Flushinp = Curses_Err then -- docu says that never happens, but...
2054 raise Curses_Exception;
2057 ------------------------------------------------------------------------------
2058 function Baudrate return Natural
2060 function Baud return C_Int;
2061 pragma Import (C, Baud, "baudrate");
2063 return Natural (Baud);
2066 function Erase_Character return Character
2068 function Erasechar return C_Int;
2069 pragma Import (C, Erasechar, "erasechar");
2071 return Character'Val (Erasechar);
2072 end Erase_Character;
2074 function Kill_Character return Character
2076 function Killchar return C_Int;
2077 pragma Import (C, Killchar, "killchar");
2079 return Character'Val (Killchar);
2082 function Has_Insert_Character return Boolean
2084 function Has_Ic return Curses_Bool;
2085 pragma Import (C, Has_Ic, "has_ic");
2087 if Has_Ic = Curses_Bool_False then
2092 end Has_Insert_Character;
2094 function Has_Insert_Line return Boolean
2096 function Has_Il return Curses_Bool;
2097 pragma Import (C, Has_Il, "has_il");
2099 if Has_Il = Curses_Bool_False then
2104 end Has_Insert_Line;
2106 function Supported_Attributes return Character_Attribute_Set
2108 function Termattrs return C_Chtype;
2109 pragma Import (C, Termattrs, "termattrs");
2111 Ch : constant Attributed_Character := Chtype_To_AttrChar (Termattrs);
2114 end Supported_Attributes;
2116 procedure Long_Name (Name : out String)
2118 function Longname return chars_ptr;
2119 pragma Import (C, Longname, "longname");
2121 Fill_String (Longname, Name);
2124 function Long_Name return String
2126 function Longname return chars_ptr;
2127 pragma Import (C, Longname, "longname");
2129 return Fill_String (Longname);
2132 procedure Terminal_Name (Name : out String)
2134 function Termname return chars_ptr;
2135 pragma Import (C, Termname, "termname");
2137 Fill_String (Termname, Name);
2140 function Terminal_Name return String
2142 function Termname return chars_ptr;
2143 pragma Import (C, Termname, "termname");
2145 return Fill_String (Termname);
2147 ------------------------------------------------------------------------------
2148 procedure Init_Pair (Pair : in Redefinable_Color_Pair;
2149 Fore : in Color_Number;
2150 Back : in Color_Number)
2152 function Initpair (Pair : C_Short;
2154 Back : C_Short) return C_Int;
2155 pragma Import (C, Initpair, "init_pair");
2157 if Integer (Pair) >= Number_Of_Color_Pairs then
2158 raise Constraint_Error;
2160 if Integer (Fore) >= Number_Of_Colors or else
2161 Integer (Back) >= Number_Of_Colors then raise Constraint_Error;
2163 if Initpair (C_Short (Pair), C_Short (Fore), C_Short (Back))
2165 raise Curses_Exception;
2169 procedure Pair_Content (Pair : in Color_Pair;
2170 Fore : out Color_Number;
2171 Back : out Color_Number)
2173 type C_Short_Access is access all C_Short;
2174 function Paircontent (Pair : C_Short;
2175 Fp : C_Short_Access;
2176 Bp : C_Short_Access) return C_Int;
2177 pragma Import (C, Paircontent, "pair_content");
2179 F, B : aliased C_Short;
2181 if Paircontent (C_Short (Pair), F'Access, B'Access) = Curses_Err then
2182 raise Curses_Exception;
2184 Fore := Color_Number (F);
2185 Back := Color_Number (B);
2189 function Has_Colors return Boolean
2191 function Hascolors return Curses_Bool;
2192 pragma Import (C, Hascolors, "has_colors");
2194 if Hascolors = Curses_Bool_False then
2201 procedure Init_Color (Color : in Color_Number;
2203 Green : in RGB_Value;
2204 Blue : in RGB_Value)
2206 function Initcolor (Col : C_Short;
2209 Blue : C_Short) return C_Int;
2210 pragma Import (C, Initcolor, "init_color");
2212 if Initcolor (C_Short (Color), C_Short (Red), C_Short (Green),
2213 C_Short (Blue)) = Curses_Err then
2214 raise Curses_Exception;
2218 function Can_Change_Color return Boolean
2220 function Canchangecolor return Curses_Bool;
2221 pragma Import (C, Canchangecolor, "can_change_color");
2223 if Canchangecolor = Curses_Bool_False then
2228 end Can_Change_Color;
2230 procedure Color_Content (Color : in Color_Number;
2231 Red : out RGB_Value;
2232 Green : out RGB_Value;
2233 Blue : out RGB_Value)
2235 type C_Short_Access is access all C_Short;
2237 function Colorcontent (Color : C_Short; R, G, B : C_Short_Access)
2239 pragma Import (C, Colorcontent, "color_content");
2241 R, G, B : aliased C_Short;
2243 if Colorcontent (C_Short (Color), R'Access, G'Access, B'Access) =
2245 raise Curses_Exception;
2247 Red := RGB_Value (R);
2248 Green := RGB_Value (G);
2249 Blue := RGB_Value (B);
2253 ------------------------------------------------------------------------------
2254 procedure Save_Curses_Mode (Mode : in Curses_Mode)
2256 function Def_Prog_Mode return C_Int;
2257 pragma Import (C, Def_Prog_Mode, "def_prog_mode");
2258 function Def_Shell_Mode return C_Int;
2259 pragma Import (C, Def_Shell_Mode, "def_shell_mode");
2264 when Curses => Err := Def_Prog_Mode;
2265 when Shell => Err := Def_Shell_Mode;
2267 if Err = Curses_Err then
2268 raise Curses_Exception;
2270 end Save_Curses_Mode;
2272 procedure Reset_Curses_Mode (Mode : in Curses_Mode)
2274 function Reset_Prog_Mode return C_Int;
2275 pragma Import (C, Reset_Prog_Mode, "reset_prog_mode");
2276 function Reset_Shell_Mode return C_Int;
2277 pragma Import (C, Reset_Shell_Mode, "reset_shell_mode");
2282 when Curses => Err := Reset_Prog_Mode;
2283 when Shell => Err := Reset_Shell_Mode;
2285 if Err = Curses_Err then
2286 raise Curses_Exception;
2288 end Reset_Curses_Mode;
2290 procedure Save_Terminal_State
2292 function Savetty return C_Int;
2293 pragma Import (C, Savetty, "savetty");
2295 if Savetty = Curses_Err then
2296 raise Curses_Exception;
2298 end Save_Terminal_State;
2300 procedure Reset_Terminal_State
2302 function Resetty return C_Int;
2303 pragma Import (C, Resetty, "resetty");
2305 if Resetty = Curses_Err then
2306 raise Curses_Exception;
2308 end Reset_Terminal_State;
2310 procedure Rip_Off_Lines (Lines : in Integer;
2311 Proc : in Stdscr_Init_Proc)
2313 function Ripoffline (Lines : C_Int;
2314 Proc : Stdscr_Init_Proc) return C_Int;
2315 pragma Import (C, Ripoffline, "_nc_ripoffline");
2317 if Ripoffline (C_Int (Lines), Proc) = Curses_Err then
2318 raise Curses_Exception;
2322 procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility)
2324 function Curs_Set (Curs : C_Int) return C_Int;
2325 pragma Import (C, Curs_Set, "curs_set");
2329 Res := Curs_Set (Cursor_Visibility'Pos (Visibility));
2330 if Res /= Curses_Err then
2331 Visibility := Cursor_Visibility'Val (Res);
2333 end Set_Cursor_Visibility;
2335 procedure Nap_Milli_Seconds (Ms : in Natural)
2337 function Napms (Ms : C_Int) return C_Int;
2338 pragma Import (C, Napms, "napms");
2340 if Napms (C_Int (Ms)) = Curses_Err then
2341 raise Curses_Exception;
2343 end Nap_Milli_Seconds;
2344 ------------------------------------------------------------------------------
2345 include(`Public_Variables')
2346 ------------------------------------------------------------------------------
2347 procedure Transform_Coordinates
2348 (W : in Window := Standard_Window;
2349 Line : in out Line_Position;
2350 Column : in out Column_Position;
2351 Dir : in Transform_Direction := From_Screen)
2353 type Int_Access is access all C_Int;
2354 function Transform (W : Window;
2356 Dir : Curses_Bool) return C_Int;
2357 pragma Import (C, Transform, "wmouse_trafo");
2359 X : aliased C_Int := C_Int (Column);
2360 Y : aliased C_Int := C_Int (Line);
2361 D : Curses_Bool := Curses_Bool_False;
2364 if Dir = To_Screen then
2367 R := Transform (W, Y'Access, X'Access, D);
2368 if R = Curses_False then
2369 raise Curses_Exception;
2371 Line := Line_Position (Y);
2372 Column := Column_Position (X);
2374 end Transform_Coordinates;
2375 ------------------------------------------------------------------------------
2376 procedure Use_Default_Colors is
2377 function C_Use_Default_Colors return C_Int;
2378 pragma Import (C, C_Use_Default_Colors, "use_default_colors");
2379 Err : constant C_Int := C_Use_Default_Colors;
2381 if Err = Curses_Err then
2382 raise Curses_Exception;
2384 end Use_Default_Colors;
2386 procedure Assume_Default_Colors (Fore : Color_Number := Default_Color;
2387 Back : Color_Number := Default_Color)
2389 function C_Assume_Default_Colors (Fore : C_Int;
2390 Back : C_Int) return C_Int;
2391 pragma Import (C, C_Assume_Default_Colors, "assume_default_colors");
2393 Err : constant C_Int := C_Assume_Default_Colors (C_Int (Fore),
2396 if Err = Curses_Err then
2397 raise Curses_Exception;
2399 end Assume_Default_Colors;
2400 ------------------------------------------------------------------------------
2401 function Curses_Version return String
2403 function curses_versionC return chars_ptr;
2404 pragma Import (C, curses_versionC, "curses_version");
2405 Result : constant chars_ptr := curses_versionC;
2407 return Fill_String (Result);
2409 ------------------------------------------------------------------------------
2410 function Use_Extended_Names (Enable : Boolean) return Boolean
2412 function use_extended_namesC (e : Curses_Bool) return C_Int;
2413 pragma Import (C, use_extended_namesC, "use_extended_names");
2415 Res : constant C_Int :=
2416 use_extended_namesC (Curses_Bool (Boolean'Pos (Enable)));
2418 if Res = C_Int (Curses_Bool_False) then
2423 end Use_Extended_Names;
2424 ------------------------------------------------------------------------------
2425 procedure Screen_Dump_To_File (Filename : in String)
2427 function scr_dump (f : char_array) return C_Int;
2428 pragma Import (C, scr_dump, "scr_dump");
2429 Txt : char_array (0 .. Filename'Length);
2432 To_C (Filename, Txt, Length);
2433 if Curses_Err = scr_dump (Txt) then
2434 raise Curses_Exception;
2436 end Screen_Dump_To_File;
2438 procedure Screen_Restore_From_File (Filename : in String)
2440 function scr_restore (f : char_array) return C_Int;
2441 pragma Import (C, scr_restore, "scr_restore");
2442 Txt : char_array (0 .. Filename'Length);
2445 To_C (Filename, Txt, Length);
2446 if Curses_Err = scr_restore (Txt) then
2447 raise Curses_Exception;
2449 end Screen_Restore_From_File;
2451 procedure Screen_Init_From_File (Filename : in String)
2453 function scr_init (f : char_array) return C_Int;
2454 pragma Import (C, scr_init, "scr_init");
2455 Txt : char_array (0 .. Filename'Length);
2458 To_C (Filename, Txt, Length);
2459 if Curses_Err = scr_init (Txt) then
2460 raise Curses_Exception;
2462 end Screen_Init_From_File;
2464 procedure Screen_Set_File (Filename : in String)
2466 function scr_set (f : char_array) return C_Int;
2467 pragma Import (C, scr_set, "scr_set");
2468 Txt : char_array (0 .. Filename'Length);
2471 To_C (Filename, Txt, Length);
2472 if Curses_Err = scr_set (Txt) then
2473 raise Curses_Exception;
2475 end Screen_Set_File;
2476 ------------------------------------------------------------------------------
2477 procedure Resize (Win : Window := Standard_Window;
2478 Number_Of_Lines : Line_Count;
2479 Number_Of_Columns : Column_Count) is
2480 function wresize (win : Window;
2482 columns : C_Int) return C_Int;
2483 pragma Import (C, wresize);
2486 C_Int (Number_Of_Lines),
2487 C_Int (Number_Of_Columns)) = Curses_Err then
2488 raise Curses_Exception;
2491 ------------------------------------------------------------------------------
2493 end Terminal_Interface.Curses;