1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding --
5 -- Terminal_Interface.Curses --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 1998 Free Software Foundation, Inc. --
12 -- Permission is hereby granted, free of charge, to any person obtaining a --
13 -- copy of this software and associated documentation files (the --
14 -- "Software"), to deal in the Software without restriction, including --
15 -- without limitation the rights to use, copy, modify, merge, publish, --
16 -- distribute, distribute with modifications, sublicense, and/or sell --
17 -- copies of the Software, and to permit persons to whom the Software is --
18 -- furnished to do so, subject to the following conditions: --
20 -- The above copyright notice and this permission notice shall be included --
21 -- in all copies or substantial portions of the Software. --
23 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
24 -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
25 -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
26 -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
27 -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
28 -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
29 -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
31 -- Except as contained in this notice, the name(s) of the above copyright --
32 -- holders shall not be used in advertising or otherwise to promote the --
33 -- sale, use or other dealings in this Software without prior written --
35 ------------------------------------------------------------------------------
36 -- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996
39 -- Binding Version 01.00
40 ------------------------------------------------------------------------------
43 with Terminal_Interface.Curses.Aux;
44 with Interfaces.C; use Interfaces.C;
45 with Interfaces.C.Strings; use Interfaces.C.Strings;
46 with Interfaces.C.Pointers;
47 with Ada.Characters.Handling; use Ada.Characters.Handling;
48 with Ada.Strings.Fixed;
49 with Ada.Unchecked_Conversion;
51 package body Terminal_Interface.Curses is
54 use type System.Bit_Order;
56 package ASF renames Ada.Strings.Fixed;
58 type chtype_array is array (size_t range <>)
59 of aliased Attributed_Character;
60 pragma Convention (C, chtype_array);
62 ------------------------------------------------------------------------------
65 function W_Get_Element (Win : in Window;
66 Offset : in Natural) return Element;
68 function W_Get_Element (Win : in Window;
69 Offset : in Natural) return Element is
70 type E_Array is array (Natural range <>) of aliased Element;
71 package C_E_Array is new
72 Interfaces.C.Pointers (Natural, Element, E_Array, Element'Val (0));
75 function To_Pointer is new
76 Ada.Unchecked_Conversion (Window, Pointer);
78 P : Pointer := To_Pointer (Win);
80 if Win = Null_Window then
81 raise Curses_Exception;
83 P := P + ptrdiff_t (Offset);
88 function W_Get_Int is new W_Get_Element (C_Int);
89 function W_Get_Short is new W_Get_Element (C_Short);
90 function W_Get_Byte is new W_Get_Element (Interfaces.C.unsigned_char);
92 ------------------------------------------------------------------------------
93 function Key_Name (Key : in Real_Key_Code) return String
95 function Keyname (K : C_Int) return chars_ptr;
96 pragma Import (C, Keyname, "keyname");
100 if Key <= Character'Pos (Character'Last) then
101 Ch := Character'Val (Key);
102 if Is_Control (Ch) then
103 return Un_Control (Attributed_Character'(Ch => Ch,
104 Color => Color_Pair'First,
105 Attr => Normal_Video));
106 elsif Is_Graphic (Ch) then
117 return Fill_String (Keyname (C_Int (Key)));
121 procedure Key_Name (Key : in Real_Key_Code;
125 ASF.Move (Key_Name (Key), Name);
128 ------------------------------------------------------------------------------
129 procedure Init_Screen
131 function Initscr return Window;
132 pragma Import (C, Initscr, "initscr");
137 if W = Null_Window then
138 raise Curses_Exception;
142 procedure End_Windows
144 function Endwin return C_Int;
145 pragma Import (C, Endwin, "endwin");
147 if Endwin = Curses_Err then
148 raise Curses_Exception;
152 function Is_End_Window return Boolean
154 function Isendwin return Curses_Bool;
155 pragma Import (C, Isendwin, "isendwin");
157 if Isendwin = Curses_Bool_False then
163 ------------------------------------------------------------------------------
164 procedure Move_Cursor (Win : in Window := Standard_Window;
165 Line : in Line_Position;
166 Column : in Column_Position)
168 function Wmove (Win : Window;
172 pragma Import (C, Wmove, "wmove");
174 if Wmove (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
175 raise Curses_Exception;
178 ------------------------------------------------------------------------------
179 procedure Add (Win : in Window := Standard_Window;
180 Ch : in Attributed_Character)
182 function Waddch (W : Window;
183 Ch : C_Chtype) return C_Int;
184 pragma Import (C, Waddch, "waddch");
186 if Waddch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
187 raise Curses_Exception;
191 procedure Add (Win : in Window := Standard_Window;
196 Attributed_Character'(Ch => Ch,
197 Color => Color_Pair'First,
198 Attr => Normal_Video));
202 (Win : in Window := Standard_Window;
203 Line : in Line_Position;
204 Column : in Column_Position;
205 Ch : in Attributed_Character)
207 function mvwaddch (W : Window;
210 Ch : C_Chtype) return C_Int;
211 pragma Import (C, mvwaddch, "mvwaddch");
213 if mvwaddch (Win, C_Int (Line),
215 AttrChar_To_Chtype (Ch)) = Curses_Err then
216 raise Curses_Exception;
221 (Win : in Window := Standard_Window;
222 Line : in Line_Position;
223 Column : in Column_Position;
230 Attributed_Character'(Ch => Ch,
231 Color => Color_Pair'First,
232 Attr => Normal_Video));
235 procedure Add_With_Immediate_Echo
236 (Win : in Window := Standard_Window;
237 Ch : in Attributed_Character)
239 function Wechochar (W : Window;
240 Ch : C_Chtype) return C_Int;
241 pragma Import (C, Wechochar, "wechochar");
243 if Wechochar (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
244 raise Curses_Exception;
246 end Add_With_Immediate_Echo;
248 procedure Add_With_Immediate_Echo
249 (Win : in Window := Standard_Window;
253 Add_With_Immediate_Echo
255 Attributed_Character'(Ch => Ch,
256 Color => Color_Pair'First,
257 Attr => Normal_Video));
258 end Add_With_Immediate_Echo;
259 ------------------------------------------------------------------------------
260 function Create (Number_Of_Lines : Line_Count;
261 Number_Of_Columns : Column_Count;
262 First_Line_Position : Line_Position;
263 First_Column_Position : Column_Position) return Window
265 function Newwin (Number_Of_Lines : C_Int;
266 Number_Of_Columns : C_Int;
267 First_Line_Position : C_Int;
268 First_Column_Position : C_Int) return Window;
269 pragma Import (C, Newwin, "newwin");
273 W := Newwin (C_Int (Number_Of_Lines),
274 C_Int (Number_Of_Columns),
275 C_Int (First_Line_Position),
276 C_Int (First_Column_Position));
277 if W = Null_Window then
278 raise Curses_Exception;
283 procedure Delete (Win : in out Window)
285 function Wdelwin (W : Window) return C_Int;
286 pragma Import (C, Wdelwin, "delwin");
288 if Wdelwin (Win) = Curses_Err then
289 raise Curses_Exception;
295 (Win : Window := Standard_Window;
296 Number_Of_Lines : Line_Count;
297 Number_Of_Columns : Column_Count;
298 First_Line_Position : Line_Position;
299 First_Column_Position : Column_Position) return Window
303 Number_Of_Lines : C_Int;
304 Number_Of_Columns : C_Int;
305 First_Line_Position : C_Int;
306 First_Column_Position : C_Int) return Window;
307 pragma Import (C, Subwin, "subwin");
312 C_Int (Number_Of_Lines),
313 C_Int (Number_Of_Columns),
314 C_Int (First_Line_Position),
315 C_Int (First_Column_Position));
316 if W = Null_Window then
317 raise Curses_Exception;
322 function Derived_Window
323 (Win : Window := Standard_Window;
324 Number_Of_Lines : Line_Count;
325 Number_Of_Columns : Column_Count;
326 First_Line_Position : Line_Position;
327 First_Column_Position : Column_Position) return Window
331 Number_Of_Lines : C_Int;
332 Number_Of_Columns : C_Int;
333 First_Line_Position : C_Int;
334 First_Column_Position : C_Int) return Window;
335 pragma Import (C, Derwin, "derwin");
340 C_Int (Number_Of_Lines),
341 C_Int (Number_Of_Columns),
342 C_Int (First_Line_Position),
343 C_Int (First_Column_Position));
344 if W = Null_Window then
345 raise Curses_Exception;
350 function Duplicate (Win : Window) return Window
352 function Dupwin (Win : Window) return Window;
353 pragma Import (C, Dupwin, "dupwin");
355 W : Window := Dupwin (Win);
357 if W = Null_Window then
358 raise Curses_Exception;
363 procedure Move_Window (Win : in Window;
364 Line : in Line_Position;
365 Column : in Column_Position)
367 function Mvwin (Win : Window;
369 Column : C_Int) return C_Int;
370 pragma Import (C, Mvwin, "mvwin");
372 if Mvwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
373 raise Curses_Exception;
377 procedure Move_Derived_Window (Win : in Window;
378 Line : in Line_Position;
379 Column : in Column_Position)
381 function Mvderwin (Win : Window;
383 Column : C_Int) return C_Int;
384 pragma Import (C, Mvderwin, "mvderwin");
386 if Mvderwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
387 raise Curses_Exception;
389 end Move_Derived_Window;
391 procedure Set_Synch_Mode (Win : in Window := Standard_Window;
392 Mode : in Boolean := False)
394 function Syncok (Win : Window;
395 Mode : Curses_Bool) return C_Int;
396 pragma Import (C, Syncok, "syncok");
398 if Syncok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
399 raise Curses_Exception;
402 ------------------------------------------------------------------------------
403 procedure Add (Win : in Window := Standard_Window;
405 Len : in Integer := -1)
407 type Char_Ptr is access all Interfaces.C.char;
408 function Waddnstr (Win : Window;
410 Len : C_Int := -1) return C_Int;
411 pragma Import (C, Waddnstr, "waddnstr");
413 Txt : char_array (0 .. Str'Length);
416 To_C (Str, Txt, Length);
417 if Waddnstr (Win, Txt (Txt'First)'Access, C_Int (Len)) = Curses_Err then
418 raise Curses_Exception;
423 (Win : in Window := Standard_Window;
424 Line : in Line_Position;
425 Column : in Column_Position;
427 Len : in Integer := -1)
430 Move_Cursor (Win, Line, Column);
433 ------------------------------------------------------------------------------
435 (Win : in Window := Standard_Window;
436 Str : in Attributed_String;
437 Len : in Integer := -1)
439 type Chtype_Ptr is access all Attributed_Character;
440 function Waddchnstr (Win : Window;
442 Len : C_Int := -1) return C_Int;
443 pragma Import (C, Waddchnstr, "waddchnstr");
445 Txt : chtype_array (0 .. Str'Length);
447 for Length in 1 .. size_t (Str'Length) loop
448 Txt (Length - 1) := Str (Natural (Length));
450 Txt (Str'Length) := Default_Character;
452 Txt (Txt'First)'Access,
453 C_Int (Len)) = Curses_Err then
454 raise Curses_Exception;
459 (Win : in Window := Standard_Window;
460 Line : in Line_Position;
461 Column : in Column_Position;
462 Str : in Attributed_String;
463 Len : in Integer := -1)
466 Move_Cursor (Win, Line, Column);
469 ------------------------------------------------------------------------------
471 (Win : in Window := Standard_Window;
472 Left_Side_Symbol : in Attributed_Character := Default_Character;
473 Right_Side_Symbol : in Attributed_Character := Default_Character;
474 Top_Side_Symbol : in Attributed_Character := Default_Character;
475 Bottom_Side_Symbol : in Attributed_Character := Default_Character;
476 Upper_Left_Corner_Symbol : in Attributed_Character := Default_Character;
477 Upper_Right_Corner_Symbol : in Attributed_Character := Default_Character;
478 Lower_Left_Corner_Symbol : in Attributed_Character := Default_Character;
479 Lower_Right_Corner_Symbol : in Attributed_Character := Default_Character)
481 function Wborder (W : Window;
489 LRC : C_Chtype) return C_Int;
490 pragma Import (C, Wborder, "wborder");
493 AttrChar_To_Chtype (Left_Side_Symbol),
494 AttrChar_To_Chtype (Right_Side_Symbol),
495 AttrChar_To_Chtype (Top_Side_Symbol),
496 AttrChar_To_Chtype (Bottom_Side_Symbol),
497 AttrChar_To_Chtype (Upper_Left_Corner_Symbol),
498 AttrChar_To_Chtype (Upper_Right_Corner_Symbol),
499 AttrChar_To_Chtype (Lower_Left_Corner_Symbol),
500 AttrChar_To_Chtype (Lower_Right_Corner_Symbol)
503 raise Curses_Exception;
508 (Win : in Window := Standard_Window;
509 Vertical_Symbol : in Attributed_Character := Default_Character;
510 Horizontal_Symbol : in Attributed_Character := Default_Character)
514 Vertical_Symbol, Vertical_Symbol,
515 Horizontal_Symbol, Horizontal_Symbol);
518 procedure Horizontal_Line
519 (Win : in Window := Standard_Window;
520 Line_Size : in Natural;
521 Line_Symbol : in Attributed_Character := Default_Character)
523 function Whline (W : Window;
525 Len : C_Int) return C_Int;
526 pragma Import (C, Whline, "whline");
529 AttrChar_To_Chtype (Line_Symbol),
530 C_Int (Line_Size)) = Curses_Err then
531 raise Curses_Exception;
535 procedure Vertical_Line
536 (Win : in Window := Standard_Window;
537 Line_Size : in Natural;
538 Line_Symbol : in Attributed_Character := Default_Character)
540 function Wvline (W : Window;
542 Len : C_Int) return C_Int;
543 pragma Import (C, Wvline, "wvline");
546 AttrChar_To_Chtype (Line_Symbol),
547 C_Int (Line_Size)) = Curses_Err then
548 raise Curses_Exception;
552 ------------------------------------------------------------------------------
553 function Get_Keystroke (Win : Window := Standard_Window)
556 function Wgetch (W : Window) return C_Int;
557 pragma Import (C, Wgetch, "wgetch");
559 C : constant C_Int := Wgetch (Win);
561 if C = Curses_Err then
564 return Real_Key_Code (C);
568 procedure Undo_Keystroke (Key : in Real_Key_Code)
570 function Ungetch (Ch : C_Int) return C_Int;
571 pragma Import (C, Ungetch, "ungetch");
573 if Ungetch (C_Int (Key)) = Curses_Err then
574 raise Curses_Exception;
578 function Has_Key (Key : Special_Key_Code) return Boolean
580 function Haskey (Key : C_Int) return C_Int;
581 pragma Import (C, Haskey, "has_key");
583 if Haskey (C_Int (Key)) = Curses_False then
590 function Is_Function_Key (Key : Special_Key_Code) return Boolean
592 L : constant Special_Key_Code := Special_Key_Code (Natural (Key_F0) +
593 Natural (Function_Key_Number'Last));
595 if (Key >= Key_F0) and then (Key <= L) then
602 function Function_Key (Key : Real_Key_Code)
603 return Function_Key_Number
606 if Is_Function_Key (Key) then
607 return Function_Key_Number (Key - Key_F0);
609 raise Constraint_Error;
613 function Function_Key_Code (Key : Function_Key_Number) return Real_Key_Code
616 return Real_Key_Code (Natural (Key_F0) + Natural (Key));
617 end Function_Key_Code;
618 ------------------------------------------------------------------------------
619 procedure Switch_Character_Attribute
620 (Win : in Window := Standard_Window;
621 Attr : in Character_Attribute_Set := Normal_Video;
622 On : in Boolean := True)
624 function Wattron (Win : Window;
625 C_Attr : C_AttrType) return C_Int;
626 pragma Import (C, Wattron, "wattr_on");
627 function Wattroff (Win : Window;
628 C_Attr : C_AttrType) return C_Int;
629 pragma Import (C, Wattroff, "wattr_off");
630 -- In Ada we use the On Boolean to control whether or not we want to
631 -- switch on or off the attributes in the set.
633 AC : constant Attributed_Character := (Ch => Character'First,
634 Color => Color_Pair'First,
638 Err := Wattron (Win, AttrChar_To_AttrType (AC));
640 Err := Wattroff (Win, AttrChar_To_AttrType (AC));
642 if Err = Curses_Err then
643 raise Curses_Exception;
645 end Switch_Character_Attribute;
647 procedure Set_Character_Attributes
648 (Win : in Window := Standard_Window;
649 Attr : in Character_Attribute_Set := Normal_Video;
650 Color : in Color_Pair := Color_Pair'First)
652 function Wattrset (Win : Window;
653 C_Attr : C_AttrType) return C_Int;
654 pragma Import (C, Wattrset, "wattrset"); -- ??? wattr_set
657 AttrChar_To_AttrType (Attributed_Character'
658 (Ch => Character'First,
660 Attr => Attr))) = Curses_Err then
661 raise Curses_Exception;
663 end Set_Character_Attributes;
665 function Get_Character_Attribute (Win : Window := Standard_Window)
666 return Character_Attribute_Set
668 function Wattrget (Win : Window;
669 Atr : access C_AttrType;
670 Col : access C_Short;
671 Opt : System.Address) return C_Int;
672 pragma Import (C, Wattrget, "wattr_get");
674 Attr : aliased C_AttrType;
675 Col : aliased C_Short;
676 Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
677 System.Null_Address);
678 Ch : Attributed_Character;
680 if Res = Curses_Ok then
681 Ch := AttrType_To_AttrChar (Attr);
684 raise Curses_Exception;
686 end Get_Character_Attribute;
688 function Get_Character_Attribute (Win : Window := Standard_Window)
691 function Wattrget (Win : Window;
692 Atr : access C_AttrType;
693 Col : access C_Short;
694 Opt : System.Address) return C_Int;
695 pragma Import (C, Wattrget, "wattr_get");
697 Attr : aliased C_AttrType;
698 Col : aliased C_Short;
699 Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
700 System.Null_Address);
701 Ch : Attributed_Character;
703 if Res = Curses_Ok then
704 Ch := AttrType_To_AttrChar (Attr);
707 raise Curses_Exception;
709 end Get_Character_Attribute;
711 procedure Set_Color (Win : in Window := Standard_Window;
712 Pair : in Color_Pair)
714 function Wset_Color (Win : Window;
716 Opts : C_Void_Ptr) return C_Int;
717 pragma Import (C, Wset_Color, "wcolor_set");
721 C_Void_Ptr (System.Null_Address)) = Curses_Err then
722 raise Curses_Exception;
726 procedure Change_Attributes
727 (Win : in Window := Standard_Window;
728 Count : in Integer := -1;
729 Attr : in Character_Attribute_Set := Normal_Video;
730 Color : in Color_Pair := Color_Pair'First)
732 function Wchgat (Win : Window;
736 Opts : System.Address := System.Null_Address)
738 pragma Import (C, Wchgat, "wchgat");
740 Ch : constant Attributed_Character :=
741 (Ch => Character'First, Color => Color_Pair'First, Attr => Attr);
743 if Wchgat (Win, C_Int (Count), AttrChar_To_AttrType (Ch),
744 C_Short (Color)) = Curses_Err then
745 raise Curses_Exception;
747 end Change_Attributes;
749 procedure Change_Attributes
750 (Win : in Window := Standard_Window;
751 Line : in Line_Position := Line_Position'First;
752 Column : in Column_Position := Column_Position'First;
753 Count : in Integer := -1;
754 Attr : in Character_Attribute_Set := Normal_Video;
755 Color : in Color_Pair := Color_Pair'First)
758 Move_Cursor (Win, Line, Column);
759 Change_Attributes (Win, Count, Attr, Color);
760 end Change_Attributes;
761 ------------------------------------------------------------------------------
764 function Beeper return C_Int;
765 pragma Import (C, Beeper, "beep");
767 if Beeper = Curses_Err then
768 raise Curses_Exception;
772 procedure Flash_Screen
774 function Flash return C_Int;
775 pragma Import (C, Flash, "flash");
777 if Flash = Curses_Err then
778 raise Curses_Exception;
781 ------------------------------------------------------------------------------
782 procedure Set_Cbreak_Mode (SwitchOn : in Boolean := True)
784 function Cbreak return C_Int;
785 pragma Import (C, Cbreak, "cbreak");
786 function NoCbreak return C_Int;
787 pragma Import (C, NoCbreak, "nocbreak");
796 if Err = Curses_Err then
797 raise Curses_Exception;
801 procedure Set_Raw_Mode (SwitchOn : in Boolean := True)
803 function Raw return C_Int;
804 pragma Import (C, Raw, "raw");
805 function NoRaw return C_Int;
806 pragma Import (C, NoRaw, "noraw");
815 if Err = Curses_Err then
816 raise Curses_Exception;
820 procedure Set_Echo_Mode (SwitchOn : in Boolean := True)
822 function Echo return C_Int;
823 pragma Import (C, Echo, "echo");
824 function NoEcho return C_Int;
825 pragma Import (C, NoEcho, "noecho");
834 if Err = Curses_Err then
835 raise Curses_Exception;
839 procedure Set_Meta_Mode (Win : in Window := Standard_Window;
840 SwitchOn : in Boolean := True)
842 function Meta (W : Window; Mode : Curses_Bool) return C_Int;
843 pragma Import (C, Meta, "meta");
845 if Meta (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then
846 raise Curses_Exception;
850 procedure Set_KeyPad_Mode (Win : in Window := Standard_Window;
851 SwitchOn : in Boolean := True)
853 function Keypad (W : Window; Mode : Curses_Bool) return C_Int;
854 pragma Import (C, Keypad, "keypad");
856 if Keypad (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then
857 raise Curses_Exception;
861 procedure Half_Delay (Amount : in Half_Delay_Amount)
863 function Halfdelay (Amount : C_Int) return C_Int;
864 pragma Import (C, Halfdelay, "halfdelay");
866 if Halfdelay (C_Int (Amount)) = Curses_Err then
867 raise Curses_Exception;
871 procedure Set_Flush_On_Interrupt_Mode
872 (Win : in Window := Standard_Window;
873 Mode : in Boolean := True)
875 function Intrflush (Win : Window; Mode : Curses_Bool) return C_Int;
876 pragma Import (C, Intrflush, "intrflush");
878 if Intrflush (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
879 raise Curses_Exception;
881 end Set_Flush_On_Interrupt_Mode;
883 procedure Set_Queue_Interrupt_Mode
884 (Win : in Window := Standard_Window;
885 Flush : in Boolean := True)
888 pragma Import (C, Qiflush, "qiflush");
889 procedure No_Qiflush;
890 pragma Import (C, No_Qiflush, "noqiflush");
897 end Set_Queue_Interrupt_Mode;
899 procedure Set_NoDelay_Mode
900 (Win : in Window := Standard_Window;
901 Mode : in Boolean := False)
903 function Nodelay (Win : Window; Mode : Curses_Bool) return C_Int;
904 pragma Import (C, Nodelay, "nodelay");
906 if Nodelay (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
907 raise Curses_Exception;
909 end Set_NoDelay_Mode;
911 procedure Set_Timeout_Mode (Win : in Window := Standard_Window;
912 Mode : in Timeout_Mode;
915 function Wtimeout (Win : Window; Amount : C_Int) return C_Int;
916 pragma Import (C, Wtimeout, "wtimeout");
921 when Blocking => Time := -1;
922 when Non_Blocking => Time := 0;
925 raise Constraint_Error;
927 Time := C_Int (Amount);
929 if Wtimeout (Win, Time) = Curses_Err then
930 raise Curses_Exception;
932 end Set_Timeout_Mode;
934 procedure Set_Escape_Timer_Mode
935 (Win : in Window := Standard_Window;
936 Timer_Off : in Boolean := False)
938 function Notimeout (Win : Window; Mode : Curses_Bool) return C_Int;
939 pragma Import (C, Notimeout, "notimeout");
941 if Notimeout (Win, Curses_Bool (Boolean'Pos (Timer_Off)))
943 raise Curses_Exception;
945 end Set_Escape_Timer_Mode;
947 ------------------------------------------------------------------------------
948 procedure Set_NL_Mode (SwitchOn : in 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 : in Window := Standard_Window;
969 Do_Clear : in 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 : in Window := Standard_Window;
981 Do_Idl : in 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 : in Window := Standard_Window;
993 Do_Idc : in Boolean := True)
995 function IDC_Ok (W : Window; Flag : Curses_Bool) return C_Int;
996 pragma Import (C, IDC_Ok, "idcok");
998 if IDC_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idc))) = Curses_Err then
999 raise Curses_Exception;
1001 end Use_Insert_Delete_Character;
1003 procedure Leave_Cursor_After_Update
1004 (Win : in Window := Standard_Window;
1005 Do_Leave : in Boolean := True)
1007 function Leave_Ok (W : Window; Flag : Curses_Bool) return C_Int;
1008 pragma Import (C, Leave_Ok, "leaveok");
1010 if Leave_Ok (Win, Curses_Bool (Boolean'Pos (Do_Leave))) = Curses_Err then
1011 raise Curses_Exception;
1013 end Leave_Cursor_After_Update;
1015 procedure Immediate_Update_Mode
1016 (Win : in Window := Standard_Window;
1017 Mode : in Boolean := False)
1019 function Immedok (Win : Window; Mode : Curses_Bool) return C_Int;
1020 pragma Import (C, Immedok, "immedok");
1022 if Immedok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
1023 raise Curses_Exception;
1025 end Immediate_Update_Mode;
1027 procedure Allow_Scrolling
1028 (Win : in Window := Standard_Window;
1029 Mode : in Boolean := False)
1031 function Scrollok (Win : Window; Mode : Curses_Bool) return C_Int;
1032 pragma Import (C, Scrollok, "scrollok");
1034 if Scrollok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
1035 raise Curses_Exception;
1037 end Allow_Scrolling;
1039 function Scrolling_Allowed (Win : Window := Standard_Window) return Boolean
1044 when 1 => Res := C_Int (W_Get_Byte (Win, Offset_scroll));
1045 when 2 => Res := C_Int (W_Get_Short (Win, Offset_scroll));
1046 when 4 => Res := C_Int (W_Get_Int (Win, Offset_scroll));
1047 when others => raise Curses_Exception;
1051 when 0 => return False;
1052 when others => return True;
1054 end Scrolling_Allowed;
1056 procedure Set_Scroll_Region
1057 (Win : in Window := Standard_Window;
1058 Top_Line : in Line_Position;
1059 Bottom_Line : in Line_Position)
1061 function Wsetscrreg (Win : Window;
1063 Col : C_Int) return C_Int;
1064 pragma Import (C, Wsetscrreg, "wsetscrreg");
1066 if Wsetscrreg (Win, C_Int (Top_Line), C_Int (Bottom_Line))
1068 raise Curses_Exception;
1070 end Set_Scroll_Region;
1071 ------------------------------------------------------------------------------
1072 procedure Update_Screen
1074 function Do_Update return C_Int;
1075 pragma Import (C, Do_Update, "doupdate");
1077 if Do_Update = Curses_Err then
1078 raise Curses_Exception;
1082 procedure Refresh (Win : in Window := Standard_Window)
1084 function Wrefresh (W : Window) return C_Int;
1085 pragma Import (C, Wrefresh, "wrefresh");
1087 if Wrefresh (Win) = Curses_Err then
1088 raise Curses_Exception;
1092 procedure Refresh_Without_Update
1093 (Win : in Window := Standard_Window)
1095 function Wnoutrefresh (W : Window) return C_Int;
1096 pragma Import (C, Wnoutrefresh, "wnoutrefresh");
1098 if Wnoutrefresh (Win) = Curses_Err then
1099 raise Curses_Exception;
1101 end Refresh_Without_Update;
1103 procedure Redraw (Win : in Window := Standard_Window)
1105 function Redrawwin (Win : Window) return C_Int;
1106 pragma Import (C, Redrawwin, "redrawwin");
1108 if Redrawwin (Win) = Curses_Err then
1109 raise Curses_Exception;
1114 (Win : in Window := Standard_Window;
1115 Begin_Line : in Line_Position;
1116 Line_Count : in Positive)
1118 function Wredrawln (Win : Window; First : C_Int; Cnt : C_Int)
1120 pragma Import (C, Wredrawln, "wredrawln");
1124 C_Int (Line_Count)) = Curses_Err then
1125 raise Curses_Exception;
1129 ------------------------------------------------------------------------------
1130 procedure Erase (Win : in Window := Standard_Window)
1132 function Werase (W : Window) return C_Int;
1133 pragma Import (C, Werase, "werase");
1135 if Werase (Win) = Curses_Err then
1136 raise Curses_Exception;
1140 procedure Clear (Win : in Window := Standard_Window)
1142 function Wclear (W : Window) return C_Int;
1143 pragma Import (C, Wclear, "wclear");
1145 if Wclear (Win) = Curses_Err then
1146 raise Curses_Exception;
1150 procedure Clear_To_End_Of_Screen (Win : in Window := Standard_Window)
1152 function Wclearbot (W : Window) return C_Int;
1153 pragma Import (C, Wclearbot, "wclrtobot");
1155 if Wclearbot (Win) = Curses_Err then
1156 raise Curses_Exception;
1158 end Clear_To_End_Of_Screen;
1160 procedure Clear_To_End_Of_Line (Win : in Window := Standard_Window)
1162 function Wcleareol (W : Window) return C_Int;
1163 pragma Import (C, Wcleareol, "wclrtoeol");
1165 if Wcleareol (Win) = Curses_Err then
1166 raise Curses_Exception;
1168 end Clear_To_End_Of_Line;
1169 ------------------------------------------------------------------------------
1170 procedure Set_Background
1171 (Win : in Window := Standard_Window;
1172 Ch : in Attributed_Character)
1174 procedure WBackground (W : in Window; Ch : in C_Chtype);
1175 pragma Import (C, WBackground, "wbkgdset");
1177 WBackground (Win, AttrChar_To_Chtype (Ch));
1180 procedure Change_Background
1181 (Win : in Window := Standard_Window;
1182 Ch : in Attributed_Character)
1184 function WChangeBkgd (W : Window; Ch : C_Chtype) return C_Int;
1185 pragma Import (C, WChangeBkgd, "wbkgd");
1187 if WChangeBkgd (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
1188 raise Curses_Exception;
1190 end Change_Background;
1192 function Get_Background (Win : Window := Standard_Window)
1193 return Attributed_Character
1195 function Wgetbkgd (Win : Window) return C_Chtype;
1196 pragma Import (C, Wgetbkgd, "getbkgd");
1198 return Chtype_To_AttrChar (Wgetbkgd (Win));
1200 ------------------------------------------------------------------------------
1201 procedure Change_Lines_Status (Win : in Window := Standard_Window;
1202 Start : in Line_Position;
1203 Count : in Positive;
1206 function Wtouchln (Win : Window;
1209 Chg : C_Int) return C_Int;
1210 pragma Import (C, Wtouchln, "wtouchln");
1212 if Wtouchln (Win, C_Int (Start), C_Int (Count),
1213 C_Int (Boolean'Pos (State))) = Curses_Err then
1214 raise Curses_Exception;
1216 end Change_Lines_Status;
1218 procedure Touch (Win : in Window := Standard_Window)
1221 X : Column_Position;
1223 Get_Size (Win, Y, X);
1224 Change_Lines_Status (Win, 0, Positive (Y), True);
1227 procedure Untouch (Win : in Window := Standard_Window)
1230 X : Column_Position;
1232 Get_Size (Win, Y, X);
1233 Change_Lines_Status (Win, 0, Positive (Y), False);
1236 procedure Touch (Win : in Window := Standard_Window;
1237 Start : in Line_Position;
1238 Count : in Positive)
1241 Change_Lines_Status (Win, Start, Count, True);
1245 (Win : Window := Standard_Window;
1246 Line : Line_Position) return Boolean
1248 function WLineTouched (W : Window; L : C_Int) return Curses_Bool;
1249 pragma Import (C, WLineTouched, "is_linetouched");
1251 if WLineTouched (Win, C_Int (Line)) = Curses_Bool_False then
1259 (Win : Window := Standard_Window) return Boolean
1261 function WWinTouched (W : Window) return Curses_Bool;
1262 pragma Import (C, WWinTouched, "is_wintouched");
1264 if WWinTouched (Win) = Curses_Bool_False then
1270 ------------------------------------------------------------------------------
1272 (Source_Window : in Window;
1273 Destination_Window : in Window;
1274 Source_Top_Row : in Line_Position;
1275 Source_Left_Column : in Column_Position;
1276 Destination_Top_Row : in Line_Position;
1277 Destination_Left_Column : in Column_Position;
1278 Destination_Bottom_Row : in Line_Position;
1279 Destination_Right_Column : in Column_Position;
1280 Non_Destructive_Mode : in Boolean := True)
1282 function Copywin (Src : Window;
1290 Ndm : C_Int) return C_Int;
1291 pragma Import (C, Copywin, "copywin");
1293 if Copywin (Source_Window,
1295 C_Int (Source_Top_Row),
1296 C_Int (Source_Left_Column),
1297 C_Int (Destination_Top_Row),
1298 C_Int (Destination_Left_Column),
1299 C_Int (Destination_Bottom_Row),
1300 C_Int (Destination_Right_Column),
1301 Boolean'Pos (Non_Destructive_Mode)
1303 raise Curses_Exception;
1308 (Source_Window : in Window;
1309 Destination_Window : in Window)
1311 function Overwrite (Src : Window; Dst : Window) return C_Int;
1312 pragma Import (C, Overwrite, "overwrite");
1314 if Overwrite (Source_Window, Destination_Window) = Curses_Err then
1315 raise Curses_Exception;
1320 (Source_Window : in Window;
1321 Destination_Window : in Window)
1323 function Overlay (Src : Window; Dst : Window) return C_Int;
1324 pragma Import (C, Overlay, "overlay");
1326 if Overlay (Source_Window, Destination_Window) = Curses_Err then
1327 raise Curses_Exception;
1331 ------------------------------------------------------------------------------
1332 procedure Insert_Delete_Lines
1333 (Win : in Window := Standard_Window;
1334 Lines : in Integer := 1) -- default is to insert one line above
1336 function Winsdelln (W : Window; N : C_Int) return C_Int;
1337 pragma Import (C, Winsdelln, "winsdelln");
1339 if Winsdelln (Win, C_Int (Lines)) = Curses_Err then
1340 raise Curses_Exception;
1342 end Insert_Delete_Lines;
1344 procedure Delete_Line (Win : in Window := Standard_Window)
1347 Insert_Delete_Lines (Win, -1);
1350 procedure Insert_Line (Win : in Window := Standard_Window)
1353 Insert_Delete_Lines (Win, 1);
1355 ------------------------------------------------------------------------------
1359 (Win : in Window := Standard_Window;
1360 Number_Of_Lines : out Line_Count;
1361 Number_Of_Columns : out Column_Count)
1363 -- Please note: in ncurses they are one off.
1364 -- This might be different in other implementations of curses
1365 Y : C_Int := C_Int (W_Get_Short (Win, Offset_maxy)) + C_Int (Offset_XY);
1366 X : C_Int := C_Int (W_Get_Short (Win, Offset_maxx)) + C_Int (Offset_XY);
1368 Number_Of_Lines := Line_Count (Y);
1369 Number_Of_Columns := Column_Count (X);
1372 procedure Get_Window_Position
1373 (Win : in Window := Standard_Window;
1374 Top_Left_Line : out Line_Position;
1375 Top_Left_Column : out Column_Position)
1377 Y : C_Short := W_Get_Short (Win, Offset_begy);
1378 X : C_Short := W_Get_Short (Win, Offset_begx);
1380 Top_Left_Line := Line_Position (Y);
1381 Top_Left_Column := Column_Position (X);
1382 end Get_Window_Position;
1384 procedure Get_Cursor_Position
1385 (Win : in Window := Standard_Window;
1386 Line : out Line_Position;
1387 Column : out Column_Position)
1389 Y : C_Short := W_Get_Short (Win, Offset_cury);
1390 X : C_Short := W_Get_Short (Win, Offset_curx);
1392 Line := Line_Position (Y);
1393 Column := Column_Position (X);
1394 end Get_Cursor_Position;
1396 procedure Get_Origin_Relative_To_Parent
1398 Top_Left_Line : out Line_Position;
1399 Top_Left_Column : out Column_Position;
1400 Is_Not_A_Subwindow : out Boolean)
1402 Y : C_Int := W_Get_Int (Win, Offset_pary);
1403 X : C_Int := W_Get_Int (Win, Offset_parx);
1406 Top_Left_Line := Line_Position'Last;
1407 Top_Left_Column := Column_Position'Last;
1408 Is_Not_A_Subwindow := True;
1410 Top_Left_Line := Line_Position (Y);
1411 Top_Left_Column := Column_Position (X);
1412 Is_Not_A_Subwindow := False;
1414 end Get_Origin_Relative_To_Parent;
1415 ------------------------------------------------------------------------------
1416 function New_Pad (Lines : Line_Count;
1417 Columns : Column_Count) return Window
1419 function Newpad (Lines : C_Int; Columns : C_Int) return Window;
1420 pragma Import (C, Newpad, "newpad");
1424 W := Newpad (C_Int (Lines), C_Int (Columns));
1425 if W = Null_Window then
1426 raise Curses_Exception;
1433 Number_Of_Lines : Line_Count;
1434 Number_Of_Columns : Column_Count;
1435 First_Line_Position : Line_Position;
1436 First_Column_Position : Column_Position) return Window
1440 Number_Of_Lines : C_Int;
1441 Number_Of_Columns : C_Int;
1442 First_Line_Position : C_Int;
1443 First_Column_Position : C_Int) return Window;
1444 pragma Import (C, Subpad, "subpad");
1449 C_Int (Number_Of_Lines),
1450 C_Int (Number_Of_Columns),
1451 C_Int (First_Line_Position),
1452 C_Int (First_Column_Position));
1453 if W = Null_Window then
1454 raise Curses_Exception;
1461 Source_Top_Row : in Line_Position;
1462 Source_Left_Column : in Column_Position;
1463 Destination_Top_Row : in Line_Position;
1464 Destination_Left_Column : in Column_Position;
1465 Destination_Bottom_Row : in Line_Position;
1466 Destination_Right_Column : in Column_Position)
1470 Source_Top_Row : C_Int;
1471 Source_Left_Column : C_Int;
1472 Destination_Top_Row : C_Int;
1473 Destination_Left_Column : C_Int;
1474 Destination_Bottom_Row : C_Int;
1475 Destination_Right_Column : C_Int) return C_Int;
1476 pragma Import (C, Prefresh, "prefresh");
1479 C_Int (Source_Top_Row),
1480 C_Int (Source_Left_Column),
1481 C_Int (Destination_Top_Row),
1482 C_Int (Destination_Left_Column),
1483 C_Int (Destination_Bottom_Row),
1484 C_Int (Destination_Right_Column)) = Curses_Err then
1485 raise Curses_Exception;
1489 procedure Refresh_Without_Update
1491 Source_Top_Row : in Line_Position;
1492 Source_Left_Column : in Column_Position;
1493 Destination_Top_Row : in Line_Position;
1494 Destination_Left_Column : in Column_Position;
1495 Destination_Bottom_Row : in Line_Position;
1496 Destination_Right_Column : in Column_Position)
1498 function Pnoutrefresh
1500 Source_Top_Row : C_Int;
1501 Source_Left_Column : C_Int;
1502 Destination_Top_Row : C_Int;
1503 Destination_Left_Column : C_Int;
1504 Destination_Bottom_Row : C_Int;
1505 Destination_Right_Column : C_Int) return C_Int;
1506 pragma Import (C, Pnoutrefresh, "pnoutrefresh");
1508 if Pnoutrefresh (Pad,
1509 C_Int (Source_Top_Row),
1510 C_Int (Source_Left_Column),
1511 C_Int (Destination_Top_Row),
1512 C_Int (Destination_Left_Column),
1513 C_Int (Destination_Bottom_Row),
1514 C_Int (Destination_Right_Column)) = Curses_Err then
1515 raise Curses_Exception;
1517 end Refresh_Without_Update;
1519 procedure Add_Character_To_Pad_And_Echo_It
1521 Ch : in Attributed_Character)
1523 function Pechochar (Pad : Window; Ch : C_Chtype)
1525 pragma Import (C, Pechochar, "pechochar");
1527 if Pechochar (Pad, AttrChar_To_Chtype (Ch)) = Curses_Err then
1528 raise Curses_Exception;
1530 end Add_Character_To_Pad_And_Echo_It;
1532 procedure Add_Character_To_Pad_And_Echo_It
1537 Add_Character_To_Pad_And_Echo_It
1539 Attributed_Character'(Ch => Ch,
1540 Color => Color_Pair'First,
1541 Attr => Normal_Video));
1542 end Add_Character_To_Pad_And_Echo_It;
1543 ------------------------------------------------------------------------------
1544 procedure Scroll (Win : in Window := Standard_Window;
1545 Amount : in Integer := 1)
1547 function Wscrl (Win : Window; N : C_Int) return C_Int;
1548 pragma Import (C, Wscrl, "wscrl");
1551 if Wscrl (Win, C_Int (Amount)) = Curses_Err then
1552 raise Curses_Exception;
1556 ------------------------------------------------------------------------------
1557 procedure Delete_Character (Win : in Window := Standard_Window)
1559 function Wdelch (Win : Window) return C_Int;
1560 pragma Import (C, Wdelch, "wdelch");
1562 if Wdelch (Win) = Curses_Err then
1563 raise Curses_Exception;
1565 end Delete_Character;
1567 procedure Delete_Character
1568 (Win : in Window := Standard_Window;
1569 Line : in Line_Position;
1570 Column : in Column_Position)
1572 function Mvwdelch (Win : Window;
1574 Col : C_Int) return C_Int;
1575 pragma Import (C, Mvwdelch, "mvwdelch");
1577 if Mvwdelch (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
1578 raise Curses_Exception;
1580 end Delete_Character;
1581 ------------------------------------------------------------------------------
1582 function Peek (Win : Window := Standard_Window)
1583 return Attributed_Character
1585 function Winch (Win : Window) return C_Chtype;
1586 pragma Import (C, Winch, "winch");
1588 return Chtype_To_AttrChar (Winch (Win));
1592 (Win : Window := Standard_Window;
1593 Line : Line_Position;
1594 Column : Column_Position) return Attributed_Character
1596 function Mvwinch (Win : Window;
1598 Col : C_Int) return C_Chtype;
1599 pragma Import (C, Mvwinch, "mvwinch");
1601 return Chtype_To_AttrChar (Mvwinch (Win, C_Int (Line), C_Int (Column)));
1603 ------------------------------------------------------------------------------
1604 procedure Insert (Win : in Window := Standard_Window;
1605 Ch : in Attributed_Character)
1607 function Winsch (Win : Window; Ch : C_Chtype) return C_Int;
1608 pragma Import (C, Winsch, "winsch");
1610 if Winsch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
1611 raise Curses_Exception;
1616 (Win : in Window := Standard_Window;
1617 Line : in Line_Position;
1618 Column : in Column_Position;
1619 Ch : in Attributed_Character)
1621 function Mvwinsch (Win : Window;
1624 Ch : C_Chtype) return C_Int;
1625 pragma Import (C, Mvwinsch, "mvwinsch");
1630 AttrChar_To_Chtype (Ch)) = Curses_Err then
1631 raise Curses_Exception;
1634 ------------------------------------------------------------------------------
1635 procedure Insert (Win : in Window := Standard_Window;
1637 Len : in Integer := -1)
1639 type Char_Ptr is access all Interfaces.C.char;
1640 function Winsnstr (Win : Window;
1642 Len : Integer := -1) return C_Int;
1643 pragma Import (C, Winsnstr, "winsnstr");
1645 Txt : char_array (0 .. Str'Length);
1648 To_C (Str, Txt, Length);
1649 if Winsnstr (Win, Txt (Txt'First)'Access, Len) = Curses_Err then
1650 raise Curses_Exception;
1655 (Win : in Window := Standard_Window;
1656 Line : in Line_Position;
1657 Column : in Column_Position;
1659 Len : in Integer := -1)
1661 type Char_Ptr is access all Interfaces.C.char;
1662 function Mvwinsnstr (Win : Window;
1666 Len : C_Int) return C_Int;
1667 pragma Import (C, Mvwinsnstr, "mvwinsnstr");
1669 Txt : char_array (0 .. Str'Length);
1672 To_C (Str, Txt, Length);
1673 if Mvwinsnstr (Win, C_Int (Line), C_Int (Column),
1674 Txt (Txt'First)'Access, C_Int (Len))
1676 raise Curses_Exception;
1679 ------------------------------------------------------------------------------
1680 procedure Peek (Win : in Window := Standard_Window;
1682 Len : in Integer := -1)
1684 function Winnstr (Win : Window;
1686 Len : C_Int) return C_Int;
1687 pragma Import (C, Winnstr, "winnstr");
1690 Txt : char_array (0 .. Str'Length);
1696 if N > Str'Length then
1697 raise Constraint_Error;
1699 Txt (0) := Interfaces.C.char'First;
1700 if Winnstr (Win, Txt, C_Int (N)) = Curses_Err then
1701 raise Curses_Exception;
1703 To_Ada (Txt, Str, Cnt, True);
1704 if Cnt < Str'Length then
1705 Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
1710 (Win : in Window := Standard_Window;
1711 Line : in Line_Position;
1712 Column : in Column_Position;
1714 Len : in Integer := -1)
1717 Move_Cursor (Win, Line, Column);
1718 Peek (Win, Str, Len);
1720 ------------------------------------------------------------------------------
1722 (Win : in Window := Standard_Window;
1723 Str : out Attributed_String;
1724 Len : in Integer := -1)
1726 type Chtype_Ptr is access all Attributed_Character;
1727 function Winchnstr (Win : Window;
1729 Len : C_Int) return C_Int;
1730 pragma Import (C, Winchnstr, "winchnstr");
1733 Txt : chtype_array (0 .. Str'Length);
1739 if N > Str'Length then
1740 raise Constraint_Error;
1742 if Winchnstr (Win, Txt (Txt'First)'Access, C_Int (N)) = Curses_Err then
1743 raise Curses_Exception;
1745 for To in Str'Range loop
1746 exit when Txt (size_t (Cnt)) = Default_Character;
1747 Str (To) := Txt (size_t (Cnt));
1750 if Cnt < Str'Length then
1751 Str ((Str'First + Cnt) .. Str'Last) :=
1752 (others => (Ch => ' ',
1753 Color => Color_Pair'First,
1754 Attr => Normal_Video));
1759 (Win : in Window := Standard_Window;
1760 Line : in Line_Position;
1761 Column : in Column_Position;
1762 Str : out Attributed_String;
1763 Len : in Integer := -1)
1766 Move_Cursor (Win, Line, Column);
1767 Peek (Win, Str, Len);
1769 ------------------------------------------------------------------------------
1770 procedure Get (Win : in Window := Standard_Window;
1772 Len : in Integer := -1)
1774 function Wgetnstr (Win : Window;
1776 Len : C_Int) return C_Int;
1777 pragma Import (C, Wgetnstr, "wgetnstr");
1780 Txt : char_array (0 .. Str'Length);
1786 if N > Str'Length then
1787 raise Constraint_Error;
1789 Txt (0) := Interfaces.C.char'First;
1790 if Wgetnstr (Win, Txt, C_Int (N)) = Curses_Err then
1791 raise Curses_Exception;
1793 To_Ada (Txt, Str, Cnt, True);
1794 if Cnt < Str'Length then
1795 Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
1800 (Win : in Window := Standard_Window;
1801 Line : in Line_Position;
1802 Column : in Column_Position;
1804 Len : in Integer := -1)
1807 Move_Cursor (Win, Line, Column);
1808 Get (Win, Str, Len);
1810 ------------------------------------------------------------------------------
1811 procedure Init_Soft_Label_Keys
1812 (Format : in Soft_Label_Key_Format := Three_Two_Three)
1814 function Slk_Init (Fmt : C_Int) return C_Int;
1815 pragma Import (C, Slk_Init, "slk_init");
1817 if Slk_Init (Soft_Label_Key_Format'Pos (Format)) = Curses_Err then
1818 raise Curses_Exception;
1820 end Init_Soft_Label_Keys;
1822 procedure Set_Soft_Label_Key (Label : in Label_Number;
1824 Fmt : in Label_Justification := Left)
1826 type Char_Ptr is access all Interfaces.C.char;
1827 function Slk_Set (Label : C_Int;
1829 Fmt : C_Int) return C_Int;
1830 pragma Import (C, Slk_Set, "slk_set");
1832 Txt : char_array (0 .. Text'Length);
1835 To_C (Text, Txt, Len);
1836 if Slk_Set (C_Int (Label),
1837 Txt (Txt'First)'Access,
1838 C_Int (Label_Justification'Pos (Fmt)))
1840 raise Curses_Exception;
1842 end Set_Soft_Label_Key;
1844 procedure Refresh_Soft_Label_Keys
1846 function Slk_Refresh return C_Int;
1847 pragma Import (C, Slk_Refresh, "slk_refresh");
1849 if Slk_Refresh = Curses_Err then
1850 raise Curses_Exception;
1852 end Refresh_Soft_Label_Keys;
1854 procedure Refresh_Soft_Label_Keys_Without_Update
1856 function Slk_Noutrefresh return C_Int;
1857 pragma Import (C, Slk_Noutrefresh, "slk_noutrefresh");
1859 if Slk_Noutrefresh = Curses_Err then
1860 raise Curses_Exception;
1862 end Refresh_Soft_Label_Keys_Without_Update;
1864 procedure Get_Soft_Label_Key (Label : in Label_Number;
1867 function Slk_Label (Label : C_Int) return chars_ptr;
1868 pragma Import (C, Slk_Label, "slk_label");
1870 Fill_String (Slk_Label (C_Int (Label)), Text);
1871 end Get_Soft_Label_Key;
1873 function Get_Soft_Label_Key (Label : in Label_Number) return String
1875 function Slk_Label (Label : C_Int) return chars_ptr;
1876 pragma Import (C, Slk_Label, "slk_label");
1878 return Fill_String (Slk_Label (C_Int (Label)));
1879 end Get_Soft_Label_Key;
1881 procedure Clear_Soft_Label_Keys
1883 function Slk_Clear return C_Int;
1884 pragma Import (C, Slk_Clear, "slk_clear");
1886 if Slk_Clear = Curses_Err then
1887 raise Curses_Exception;
1889 end Clear_Soft_Label_Keys;
1891 procedure Restore_Soft_Label_Keys
1893 function Slk_Restore return C_Int;
1894 pragma Import (C, Slk_Restore, "slk_restore");
1896 if Slk_Restore = Curses_Err then
1897 raise Curses_Exception;
1899 end Restore_Soft_Label_Keys;
1901 procedure Touch_Soft_Label_Keys
1903 function Slk_Touch return C_Int;
1904 pragma Import (C, Slk_Touch, "slk_touch");
1906 if Slk_Touch = Curses_Err then
1907 raise Curses_Exception;
1909 end Touch_Soft_Label_Keys;
1911 procedure Switch_Soft_Label_Key_Attributes
1912 (Attr : in Character_Attribute_Set;
1913 On : in Boolean := True)
1915 function Slk_Attron (Ch : C_Chtype) return C_Int;
1916 pragma Import (C, Slk_Attron, "slk_attron");
1917 function Slk_Attroff (Ch : C_Chtype) return C_Int;
1918 pragma Import (C, Slk_Attroff, "slk_attroff");
1921 Ch : constant Attributed_Character := (Ch => Character'First,
1923 Color => Color_Pair'First);
1926 Err := Slk_Attron (AttrChar_To_Chtype (Ch));
1928 Err := Slk_Attroff (AttrChar_To_Chtype (Ch));
1930 if Err = Curses_Err then
1931 raise Curses_Exception;
1933 end Switch_Soft_Label_Key_Attributes;
1935 procedure Set_Soft_Label_Key_Attributes
1936 (Attr : in Character_Attribute_Set := Normal_Video;
1937 Color : in Color_Pair := Color_Pair'First)
1939 function Slk_Attrset (Ch : C_Chtype) return C_Int;
1940 pragma Import (C, Slk_Attrset, "slk_attrset");
1942 Ch : constant Attributed_Character := (Ch => Character'First,
1946 if Slk_Attrset (AttrChar_To_Chtype (Ch)) = Curses_Err then
1947 raise Curses_Exception;
1949 end Set_Soft_Label_Key_Attributes;
1951 function Get_Soft_Label_Key_Attributes return Character_Attribute_Set
1953 function Slk_Attr return C_Chtype;
1954 pragma Import (C, Slk_Attr, "slk_attr");
1956 Attr : constant C_Chtype := Slk_Attr;
1958 return Chtype_To_AttrChar (Attr).Attr;
1959 end Get_Soft_Label_Key_Attributes;
1961 function Get_Soft_Label_Key_Attributes return Color_Pair
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).Color;
1969 end Get_Soft_Label_Key_Attributes;
1971 procedure Set_Soft_Label_Key_Color (Pair : in Color_Pair)
1973 function Slk_Color (Color : in C_Short) return C_Int;
1974 pragma Import (C, Slk_Color, "slk_color");
1976 if Slk_Color (C_Short (Pair)) = Curses_Err then
1977 raise Curses_Exception;
1979 end Set_Soft_Label_Key_Color;
1981 ------------------------------------------------------------------------------
1982 procedure Enable_Key (Key : in Special_Key_Code;
1983 Enable : in Boolean := True)
1985 function Keyok (Keycode : C_Int;
1986 On_Off : Curses_Bool) return C_Int;
1987 pragma Import (C, Keyok, "keyok");
1989 if Keyok (C_Int (Key), Curses_Bool (Boolean'Pos (Enable)))
1991 raise Curses_Exception;
1994 ------------------------------------------------------------------------------
1995 procedure Define_Key (Definition : in String;
1996 Key : in Special_Key_Code)
1998 type Char_Ptr is access all Interfaces.C.char;
1999 function Defkey (Def : Char_Ptr;
2000 Key : C_Int) return C_Int;
2001 pragma Import (C, Defkey, "define_key");
2003 Txt : char_array (0 .. Definition'Length);
2006 To_C (Definition, Txt, Length);
2007 if Defkey (Txt (Txt'First)'Access, C_Int (Key)) = Curses_Err then
2008 raise Curses_Exception;
2011 ------------------------------------------------------------------------------
2012 procedure Un_Control (Ch : in Attributed_Character;
2015 function Unctrl (Ch : C_Chtype) return chars_ptr;
2016 pragma Import (C, Unctrl, "unctrl");
2018 Fill_String (Unctrl (AttrChar_To_Chtype (Ch)), Str);
2021 function Un_Control (Ch : in Attributed_Character) return String
2023 function Unctrl (Ch : C_Chtype) return chars_ptr;
2024 pragma Import (C, Unctrl, "unctrl");
2026 return Fill_String (Unctrl (AttrChar_To_Chtype (Ch)));
2029 procedure Delay_Output (Msecs : in Natural)
2031 function Delayoutput (Msecs : C_Int) return C_Int;
2032 pragma Import (C, Delayoutput, "delay_output");
2034 if Delayoutput (C_Int (Msecs)) = Curses_Err then
2035 raise Curses_Exception;
2039 procedure Flush_Input
2041 function Flushinp return C_Int;
2042 pragma Import (C, Flushinp, "flushinp");
2044 if Flushinp = Curses_Err then -- docu says that never happens, but...
2045 raise Curses_Exception;
2048 ------------------------------------------------------------------------------
2049 function Baudrate return Natural
2051 function Baud return C_Int;
2052 pragma Import (C, Baud, "baudrate");
2054 return Natural (Baud);
2057 function Erase_Character return Character
2059 function Erasechar return C_Int;
2060 pragma Import (C, Erasechar, "erasechar");
2062 return Character'Val (Erasechar);
2063 end Erase_Character;
2065 function Kill_Character return Character
2067 function Killchar return C_Int;
2068 pragma Import (C, Killchar, "killchar");
2070 return Character'Val (Killchar);
2073 function Has_Insert_Character return Boolean
2075 function Has_Ic return Curses_Bool;
2076 pragma Import (C, Has_Ic, "has_ic");
2078 if Has_Ic = Curses_Bool_False then
2083 end Has_Insert_Character;
2085 function Has_Insert_Line return Boolean
2087 function Has_Il return Curses_Bool;
2088 pragma Import (C, Has_Il, "has_il");
2090 if Has_Il = Curses_Bool_False then
2095 end Has_Insert_Line;
2097 function Supported_Attributes return Character_Attribute_Set
2099 function Termattrs return C_Chtype;
2100 pragma Import (C, Termattrs, "termattrs");
2102 Ch : constant Attributed_Character := Chtype_To_AttrChar (Termattrs);
2105 end Supported_Attributes;
2107 procedure Long_Name (Name : out String)
2109 function Longname return chars_ptr;
2110 pragma Import (C, Longname, "longname");
2112 Fill_String (Longname, Name);
2115 function Long_Name return String
2117 function Longname return chars_ptr;
2118 pragma Import (C, Longname, "longname");
2120 return Fill_String (Longname);
2123 procedure Terminal_Name (Name : out String)
2125 function Termname return chars_ptr;
2126 pragma Import (C, Termname, "termname");
2128 Fill_String (Termname, Name);
2131 function Terminal_Name return String
2133 function Termname return chars_ptr;
2134 pragma Import (C, Termname, "termname");
2136 return Fill_String (Termname);
2138 ------------------------------------------------------------------------------
2139 procedure Init_Pair (Pair : in Redefinable_Color_Pair;
2140 Fore : in Color_Number;
2141 Back : in Color_Number)
2143 function Initpair (Pair : C_Short;
2145 Back : C_Short) return C_Int;
2146 pragma Import (C, Initpair, "init_pair");
2148 if Integer (Pair) >= Number_Of_Color_Pairs then
2149 raise Constraint_Error;
2151 if Integer (Fore) >= Number_Of_Colors or else
2152 Integer (Back) >= Number_Of_Colors then raise Constraint_Error;
2154 if Initpair (C_Short (Pair), C_Short (Fore), C_Short (Back))
2156 raise Curses_Exception;
2160 procedure Pair_Content (Pair : in Color_Pair;
2161 Fore : out Color_Number;
2162 Back : out Color_Number)
2164 type C_Short_Access is access all C_Short;
2165 function Paircontent (Pair : C_Short;
2166 Fp : C_Short_Access;
2167 Bp : C_Short_Access) return C_Int;
2168 pragma Import (C, Paircontent, "pair_content");
2170 F, B : aliased C_Short;
2172 if Paircontent (C_Short (Pair), F'Access, B'Access) = Curses_Err then
2173 raise Curses_Exception;
2175 Fore := Color_Number (F);
2176 Back := Color_Number (B);
2180 function Has_Colors return Boolean
2182 function Hascolors return Curses_Bool;
2183 pragma Import (C, Hascolors, "has_colors");
2185 if Hascolors = Curses_Bool_False then
2192 procedure Init_Color (Color : in Color_Number;
2194 Green : in RGB_Value;
2195 Blue : in RGB_Value)
2197 function Initcolor (Col : C_Short;
2200 Blue : C_Short) return C_Int;
2201 pragma Import (C, Initcolor, "init_color");
2203 if Initcolor (C_Short (Color), C_Short (Red), C_Short (Green),
2204 C_Short (Blue)) = Curses_Err then
2205 raise Curses_Exception;
2209 function Can_Change_Color return Boolean
2211 function Canchangecolor return Curses_Bool;
2212 pragma Import (C, Canchangecolor, "can_change_color");
2214 if Canchangecolor = Curses_Bool_False then
2219 end Can_Change_Color;
2221 procedure Color_Content (Color : in Color_Number;
2222 Red : out RGB_Value;
2223 Green : out RGB_Value;
2224 Blue : out RGB_Value)
2226 type C_Short_Access is access all C_Short;
2228 function Colorcontent (Color : C_Short; R, G, B : C_Short_Access)
2230 pragma Import (C, Colorcontent, "color_content");
2232 R, G, B : aliased C_Short;
2234 if Colorcontent (C_Short (Color), R'Access, G'Access, B'Access) =
2236 raise Curses_Exception;
2238 Red := RGB_Value (R);
2239 Green := RGB_Value (G);
2240 Blue := RGB_Value (B);
2244 ------------------------------------------------------------------------------
2245 procedure Save_Curses_Mode (Mode : in Curses_Mode)
2247 function Def_Prog_Mode return C_Int;
2248 pragma Import (C, Def_Prog_Mode, "def_prog_mode");
2249 function Def_Shell_Mode return C_Int;
2250 pragma Import (C, Def_Shell_Mode, "def_shell_mode");
2255 when Curses => Err := Def_Prog_Mode;
2256 when Shell => Err := Def_Shell_Mode;
2258 if Err = Curses_Err then
2259 raise Curses_Exception;
2261 end Save_Curses_Mode;
2263 procedure Reset_Curses_Mode (Mode : in Curses_Mode)
2265 function Reset_Prog_Mode return C_Int;
2266 pragma Import (C, Reset_Prog_Mode, "reset_prog_mode");
2267 function Reset_Shell_Mode return C_Int;
2268 pragma Import (C, Reset_Shell_Mode, "reset_shell_mode");
2273 when Curses => Err := Reset_Prog_Mode;
2274 when Shell => Err := Reset_Shell_Mode;
2276 if Err = Curses_Err then
2277 raise Curses_Exception;
2279 end Reset_Curses_Mode;
2281 procedure Save_Terminal_State
2283 function Savetty return C_Int;
2284 pragma Import (C, Savetty, "savetty");
2286 if Savetty = Curses_Err then
2287 raise Curses_Exception;
2289 end Save_Terminal_State;
2291 procedure Reset_Terminal_State
2293 function Resetty return C_Int;
2294 pragma Import (C, Resetty, "resetty");
2296 if Resetty = Curses_Err then
2297 raise Curses_Exception;
2299 end Reset_Terminal_State;
2301 procedure Rip_Off_Lines (Lines : in Integer;
2302 Proc : in Stdscr_Init_Proc)
2304 function Ripoffline (Lines : C_Int;
2305 Proc : Stdscr_Init_Proc) return C_Int;
2306 pragma Import (C, Ripoffline, "_nc_ripoffline");
2308 if Ripoffline (C_Int (Lines), Proc) = Curses_Err then
2309 raise Curses_Exception;
2313 procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility)
2315 function Curs_Set (Curs : C_Int) return C_Int;
2316 pragma Import (C, Curs_Set, "curs_set");
2320 Res := Curs_Set (Cursor_Visibility'Pos (Visibility));
2321 if Res /= Curses_Err then
2322 Visibility := Cursor_Visibility'Val (Res);
2324 end Set_Cursor_Visibility;
2326 procedure Nap_Milli_Seconds (Ms : in Natural)
2328 function Napms (Ms : C_Int) return C_Int;
2329 pragma Import (C, Napms, "napms");
2331 if Napms (C_Int (Ms)) = Curses_Err then
2332 raise Curses_Exception;
2334 end Nap_Milli_Seconds;
2335 ------------------------------------------------------------------------------
2337 function Standard_Window return Window
2340 pragma Import (C, Stdscr, "stdscr");
2343 end Standard_Window;
2345 function Lines return Line_Count
2348 pragma Import (C, C_Lines, "LINES");
2350 return Line_Count (C_Lines);
2353 function Columns return Column_Count
2356 pragma Import (C, C_Columns, "COLS");
2358 return Column_Count (C_Columns);
2361 function Tab_Size return Natural
2364 pragma Import (C, C_Tab_Size, "TABSIZE");
2366 return Natural (C_Tab_Size);
2369 function Number_Of_Colors return Natural
2371 C_Number_Of_Colors : C_Int;
2372 pragma Import (C, C_Number_Of_Colors, "COLORS");
2374 return Natural (C_Number_Of_Colors);
2375 end Number_Of_Colors;
2377 function Number_Of_Color_Pairs return Natural
2379 C_Number_Of_Color_Pairs : C_Int;
2380 pragma Import (C, C_Number_Of_Color_Pairs, "COLOR_PAIRS");
2382 return Natural (C_Number_Of_Color_Pairs);
2383 end Number_Of_Color_Pairs;
2384 ------------------------------------------------------------------------------
2385 procedure Transform_Coordinates
2386 (W : in Window := Standard_Window;
2387 Line : in out Line_Position;
2388 Column : in out Column_Position;
2389 Dir : in Transform_Direction := From_Screen)
2391 type Int_Access is access all C_Int;
2392 function Transform (W : Window;
2394 Dir : Curses_Bool) return C_Int;
2395 pragma Import (C, Transform, "wmouse_trafo");
2397 X : aliased C_Int := C_Int (Column);
2398 Y : aliased C_Int := C_Int (Line);
2399 D : Curses_Bool := Curses_Bool_False;
2402 if Dir = To_Screen then
2405 R := Transform (W, Y'Access, X'Access, D);
2406 if R = Curses_False then
2407 raise Curses_Exception;
2409 Line := Line_Position (Y);
2410 Column := Column_Position (X);
2412 end Transform_Coordinates;
2414 end Terminal_Interface.Curses;