diff options
Diffstat (limited to 'ncurses-5.2/Ada95/src')
52 files changed, 9353 insertions, 0 deletions
diff --git a/ncurses-5.2/Ada95/src/Makefile.in b/ncurses-5.2/Ada95/src/Makefile.in new file mode 100644 index 0000000..cd8e546 --- /dev/null +++ b/ncurses-5.2/Ada95/src/Makefile.in @@ -0,0 +1,352 @@ +############################################################################## +# Copyright (c) 1998 Free Software Foundation, Inc. # +# # +# Permission is hereby granted, free of charge, to any person obtaining a # +# copy of this software and associated documentation files (the "Software"), # +# to deal in the Software without restriction, including without limitation # +# the rights to use, copy, modify, merge, publish, distribute, distribute # +# with modifications, sublicense, and/or sell copies of the Software, and to # +# permit persons to whom the Software is furnished to do so, subject to the # +# following conditions: # +# # +# The above copyright notice and this permission notice shall be included in # +# all copies or substantial portions of the Software. # +# # +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR # +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, # +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL # +# THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER # +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING # +# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER # +# DEALINGS IN THE SOFTWARE. # +# # +# Except as contained in this notice, the name(s) of the above copyright # +# holders shall not be used in advertising or otherwise to promote the sale, # +# use or other dealings in this Software without prior written # +# authorization. # +############################################################################## +# +# Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +# +# Version Control +# $Revision$ +# +.SUFFIXES: + +SHELL = /bin/sh +THIS = Makefile + +MODEL = ../../@DFT_OBJ_SUBDIR@ +DESTDIR = @DESTDIR@ +srcdir = @srcdir@ +prefix = @prefix@ +exec_prefix = @exec_prefix@ +ADA_INCLUDE = @ADA_INCLUDE@ + +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ + +AR = @AR@ +AR_OPTS = @AR_OPTS@ +AWK = @AWK@ +LN_S = @LN_S@ + +CC = @CC@ +CFLAGS = @CFLAGS@ + +CPPFLAGS = @ACPPFLAGS@ \ + -DHAVE_CONFIG_H -I$(srcdir) + +CCFLAGS = $(CPPFLAGS) $(CFLAGS) + +CFLAGS_NORMAL = $(CCFLAGS) +CFLAGS_DEBUG = $(CCFLAGS) @CC_G_OPT@ -DTRACE +CFLAGS_PROFILE = $(CCFLAGS) -pg +CFLAGS_SHARED = $(CCFLAGS) @CC_SHARED_OPTS@ + +CFLAGS_DEFAULT = $(CFLAGS_@DFT_UPR_MODEL@) + +LINK = $(CC) +LDFLAGS = @LDFLAGS@ @LD_MODEL@ @LIBS@ + +RANLIB = @RANLIB@ +################################################################################ +ADA = @cf_ada_compiler@ +ADAFLAGS = @ADAFLAGS@ -I. -I$(srcdir) + +ADAMAKE = @cf_ada_make@ +ADAMAKEFLAGS = + +CARGS = -cargs $(ADAFLAGS) +LARGS = + +ALIB = @cf_ada_package@ +ABASE = $(ALIB)-curses + +LIBALIS=$(ALIB).ali \ + $(ABASE)-aux.ali \ + $(ABASE).ali \ + $(ABASE)-mouse.ali \ + $(ABASE)-panels.ali \ + $(ABASE)-menus.ali \ + $(ABASE)-forms.ali \ + $(ABASE)-forms-field_types.ali \ + $(ABASE)-forms-field_types-alpha.ali \ + $(ABASE)-forms-field_types-alphanumeric.ali \ + $(ABASE)-forms-field_types-intfield.ali \ + $(ABASE)-forms-field_types-numeric.ali \ + $(ABASE)-forms-field_types-regexp.ali \ + $(ABASE)-forms-field_types-enumeration.ali \ + $(ABASE)-forms-field_types-ipv4_address.ali \ + $(ABASE)-forms-field_types-user.ali \ + $(ABASE)-forms-field_types-user-choice.ali \ + $(ABASE)-text_io.ali \ + $(ABASE)-text_io-aux.ali + +# Ada Library files for generic packages. Since gnat 3.10 they are +# also compiled +GENALIS=$(ABASE)-menus-menu_user_data.ali \ + $(ABASE)-menus-item_user_data.ali \ + $(ABASE)-forms-form_user_data.ali \ + $(ABASE)-forms-field_user_data.ali \ + $(ABASE)-forms-field_types-enumeration-ada.ali \ + $(ABASE)-panels-user_data.ali \ + $(ABASE)-text_io-integer_io.ali \ + $(ABASE)-text_io-float_io.ali \ + $(ABASE)-text_io-fixed_io.ali \ + $(ABASE)-text_io-decimal_io.ali \ + $(ABASE)-text_io-enumeration_io.ali \ + $(ABASE)-text_io-modular_io.ali \ + $(ABASE)-text_io-complex_io.ali + +LIBOBJS=$(ALIB).o \ + $(ABASE)-aux.o \ + $(ABASE).o \ + $(ABASE)-mouse.o \ + $(ABASE)-panels.o \ + $(ABASE)-menus.o \ + $(ABASE)-forms.o \ + $(ABASE)-forms-field_types.o \ + $(ABASE)-forms-field_types-alpha.o \ + $(ABASE)-forms-field_types-alphanumeric.o \ + $(ABASE)-forms-field_types-intfield.o \ + $(ABASE)-forms-field_types-numeric.o \ + $(ABASE)-forms-field_types-regexp.o \ + $(ABASE)-forms-field_types-enumeration.o \ + $(ABASE)-forms-field_types-ipv4_address.o \ + $(ABASE)-forms-field_types-user.o \ + $(ABASE)-forms-field_types-user-choice.o \ + $(ABASE)-text_io.o \ + $(ABASE)-text_io-aux.o + +# Ada object files for generic packages. Since gnat 3.10 they are +# also compiled +GENOBJS=$(ABASE)-menus-menu_user_data.o \ + $(ABASE)-menus-item_user_data.o \ + $(ABASE)-forms-form_user_data.o \ + $(ABASE)-forms-field_user_data.o \ + $(ABASE)-forms-field_types-enumeration-ada.o \ + $(ABASE)-panels-user_data.o \ + $(ABASE)-text_io-integer_io.o \ + $(ABASE)-text_io-float_io.o \ + $(ABASE)-text_io-fixed_io.o \ + $(ABASE)-text_io-decimal_io.o \ + $(ABASE)-text_io-enumeration_io.o \ + $(ABASE)-text_io-modular_io.o \ + $(ABASE)-text_io-complex_io.o + + +all :: libAdaCurses.a + @echo done + +libAdaCurses.a :: dotouch $(LIBOBJS) @cf_generic_objects@ + $(AR) $(AR_OPTS) $@ $(LIBOBJS) @cf_generic_objects@ + +dotouch : + @sh -c 'for f in $(LIBALIS) $(GENALIS); do test -f $$f || touch $$f; done' + +sources : + @ + +libs \ +install \ +install.libs \ +uninstall \ +uninstall.libs :: + @ + +generics: $(GENALIS) + @ + +mostlyclean :: + rm -f *.o *.ali b_t*.* *.s $(PROGS) a.out core b_*_test.c *.xr[bs] *.a + +clean :: mostlyclean + rm -f $(LIBALIS) $(GENALIS) $(LIBOBJS) $(GENOBJS) + +distclean :: clean + rm -f Makefile + +realclean :: distclean + +BASEDEPS=$(ABASE).ads $(ABASE)-aux.ads $(srcdir)/$(ABASE).adb + +$(ALIB).o: $(srcdir)/$(ALIB).ads + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ALIB).ads + + +$(ABASE)-aux.o: $(srcdir)/$(ABASE)-aux.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-aux.adb + + +$(ABASE).o: $(srcdir)/$(ABASE).adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE).adb + + +$(ABASE)-mouse.o: \ + $(ABASE)-mouse.ads \ + $(srcdir)/$(ABASE)-mouse.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-mouse.adb + + +$(ABASE)-panels.o: \ + $(ABASE)-panels.ads \ + $(srcdir)/$(ABASE)-panels.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-panels.adb + + +$(ABASE)-menus.o: \ + $(ABASE)-menus.ads \ + $(srcdir)/$(ABASE)-menus.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-menus.adb + + +$(ABASE)-forms.o: \ + $(ABASE)-forms.ads \ + $(srcdir)/$(ABASE)-forms.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms.adb + +$(ABASE)-forms-field_types.o: \ + $(ABASE)-forms-field_types.ads \ + $(srcdir)/$(ABASE)-forms-field_types.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types.adb + +$(ABASE)-forms-field_types-alpha.o: \ + $(srcdir)/$(ABASE)-forms-field_types-alpha.ads \ + $(srcdir)/$(ABASE)-forms-field_types-alpha.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-alpha.adb + +$(ABASE)-forms-field_types-alphanumeric.o: \ + $(srcdir)/$(ABASE)-forms-field_types-alphanumeric.ads \ + $(srcdir)/$(ABASE)-forms-field_types-alphanumeric.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-alphanumeric.adb + +$(ABASE)-forms-field_types-intfield.o: \ + $(srcdir)/$(ABASE)-forms-field_types-intfield.ads \ + $(srcdir)/$(ABASE)-forms-field_types-intfield.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-intfield.adb + +$(ABASE)-forms-field_types-numeric.o: \ + $(srcdir)/$(ABASE)-forms-field_types-numeric.ads \ + $(srcdir)/$(ABASE)-forms-field_types-numeric.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-numeric.adb + +$(ABASE)-forms-field_types-regexp.o: \ + $(srcdir)/$(ABASE)-forms-field_types-regexp.ads \ + $(srcdir)/$(ABASE)-forms-field_types-regexp.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-regexp.adb + +$(ABASE)-forms-field_types-enumeration.o: \ + $(srcdir)/$(ABASE)-forms-field_types-enumeration.ads \ + $(srcdir)/$(ABASE)-forms-field_types-enumeration.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-enumeration.adb + +$(ABASE)-forms-field_types-ipv4_address.o: \ + $(srcdir)/$(ABASE)-forms-field_types-ipv4_address.ads \ + $(srcdir)/$(ABASE)-forms-field_types-ipv4_address.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-ipv4_address.adb + +$(ABASE)-forms-field_types-user.o: \ + $(srcdir)/$(ABASE)-forms-field_types-user.ads \ + $(srcdir)/$(ABASE)-forms-field_types-user.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-user.adb + +$(ABASE)-forms-field_types-user-choice.o: \ + $(srcdir)/$(ABASE)-forms-field_types-user-choice.ads \ + $(srcdir)/$(ABASE)-forms-field_types-user-choice.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-user-choice.adb + +$(ABASE)-text_io.o: \ + $(srcdir)/$(ABASE)-text_io.ads \ + $(srcdir)/$(ABASE)-text_io.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io.adb + +$(ABASE)-text_io-aux.o: \ + $(srcdir)/$(ABASE)-text_io-aux.ads \ + $(srcdir)/$(ABASE)-text_io-aux.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-aux.adb + +$(ABASE)-menus-menu_user_data.o: \ + $(ABASE)-menus-menu_user_data.ads \ + $(srcdir)/$(ABASE)-menus-menu_user_data.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-menus-menu_user_data.adb + +$(ABASE)-menus-item_user_data.o: \ + $(ABASE)-menus-item_user_data.ads \ + $(srcdir)/$(ABASE)-menus-item_user_data.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-menus-item_user_data.adb + +$(ABASE)-forms-form_user_data.o: \ + $(ABASE)-forms-form_user_data.ads \ + $(srcdir)/$(ABASE)-forms-form_user_data.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-form_user_data.adb + +$(ABASE)-forms-field_user_data.o: \ + $(ABASE)-forms-field_user_data.ads \ + $(srcdir)/$(ABASE)-forms-field_user_data.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_user_data.adb + +$(ABASE)-forms-field_types-enumeration-ada.o: \ + $(srcdir)/$(ABASE)-forms-field_types-enumeration-ada.ads \ + $(srcdir)/$(ABASE)-forms-field_types-enumeration-ada.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-enumeration-ada.adb + +$(ABASE)-panels-user_data.o: \ + $(ABASE)-panels-user_data.ads \ + $(srcdir)/$(ABASE)-panels-user_data.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-panels-user_data.adb + +$(ABASE)-text_io-integer_io.o: \ + $(srcdir)/$(ABASE)-text_io-integer_io.ads \ + $(srcdir)/$(ABASE)-text_io-integer_io.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-integer_io.adb + +$(ABASE)-text_io-float_io.o: \ + $(srcdir)/$(ABASE)-text_io-float_io.ads \ + $(srcdir)/$(ABASE)-text_io-float_io.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-float_io.adb + +$(ABASE)-text_io-fixed_io.o: \ + $(srcdir)/$(ABASE)-text_io-fixed_io.ads \ + $(srcdir)/$(ABASE)-text_io-fixed_io.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-fixed_io.adb + +$(ABASE)-text_io-decimal_io.o: \ + $(srcdir)/$(ABASE)-text_io-decimal_io.ads \ + $(srcdir)/$(ABASE)-text_io-decimal_io.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-decimal_io.adb + +$(ABASE)-text_io-enumeration_io.o: \ + $(srcdir)/$(ABASE)-text_io-enumeration_io.ads \ + $(srcdir)/$(ABASE)-text_io-enumeration_io.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-enumeration_io.adb + +$(ABASE)-text_io-modular_io.o: \ + $(srcdir)/$(ABASE)-text_io-modular_io.ads \ + $(srcdir)/$(ABASE)-text_io-modular_io.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-modular_io.adb + +$(ABASE)-text_io-complex_io.o: \ + $(srcdir)/$(ABASE)-text_io-complex_io.ads \ + $(srcdir)/$(ABASE)-text_io-complex_io.adb $(BASEDEPS) + $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-complex_io.adb diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-aux.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-aux.adb new file mode 100644 index 0000000..aa8cc76 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-aux.adb @@ -0,0 +1,116 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Aux -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +package body Terminal_Interface.Curses.Aux is + -- + -- Some helpers + procedure Fill_String (Cp : in chars_ptr; + Str : out String) + is + -- Fill the string with the characters referenced by the + -- chars_ptr. + -- + Len : Natural; + begin + if Cp /= Null_Ptr then + Len := Natural (Strlen (Cp)); + if Str'Length < Len then + raise Constraint_Error; + end if; + declare + S : String (1 .. Len); + begin + S := Value (Cp); + Str (Str'First .. (Str'First + Len - 1)) := S (S'Range); + end; + else + Len := 0; + end if; + + if Len < Str'Length then + Str ((Str'First + Len) .. Str'Last) := (others => ' '); + end if; + + end Fill_String; + + function Fill_String (Cp : chars_ptr) return String + is + Len : Natural; + begin + if Cp /= Null_Ptr then + Len := Natural (Strlen (Cp)); + if Len = 0 then + return ""; + else + declare + S : String (1 .. Len); + begin + Fill_String (Cp, S); + return S; + end; + end if; + else + return ""; + end if; + end Fill_String; + + procedure Eti_Exception (Code : Eti_Error) + is + begin + case Code is + when E_Ok => null; + when E_System_Error => raise Eti_System_Error; + when E_Bad_Argument => raise Eti_Bad_Argument; + when E_Posted => raise Eti_Posted; + when E_Connected => raise Eti_Connected; + when E_Bad_State => raise Eti_Bad_State; + when E_No_Room => raise Eti_No_Room; + when E_Not_Posted => raise Eti_Not_Posted; + when E_Unknown_Command => raise Eti_Unknown_Command; + when E_No_Match => raise Eti_No_Match; + when E_Not_Selectable => raise Eti_Not_Selectable; + when E_Not_Connected => raise Eti_Not_Connected; + when E_Request_Denied => raise Eti_Request_Denied; + when E_Invalid_Field => raise Eti_Invalid_Field; + when E_Current => raise Eti_Current; + end case; + end Eti_Exception; + +end Terminal_Interface.Curses.Aux; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb new file mode 100644 index 0000000..c7a64f7 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb @@ -0,0 +1,68 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.Alpha -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Interfaces.C; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +package body Terminal_Interface.Curses.Forms.Field_Types.Alpha is + + use type Interfaces.C.int; + + procedure Set_Field_Type (Fld : in Field; + Typ : in Alpha_Field) + is + C_Alpha_Field_Type : C_Field_Type; + pragma Import (C, C_Alpha_Field_Type, "TYPE_ALPHA"); + + function Set_Fld_Type (F : Field := Fld; + Cft : C_Field_Type := C_Alpha_Field_Type; + Arg1 : C_Int) return C_Int; + pragma Import (C, Set_Fld_Type, "set_field_type"); + + Res : Eti_Error; + begin + Res := Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width)); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + Wrap_Builtin (Fld, Typ); + end Set_Field_Type; + +end Terminal_Interface.Curses.Forms.Field_Types.Alpha; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-alpha.ads b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-alpha.ads new file mode 100644 index 0000000..f869c0b --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-alpha.ads @@ -0,0 +1,53 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.Alpha -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +package Terminal_Interface.Curses.Forms.Field_Types.Alpha is + pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.Alpha); + + type Alpha_Field is new Field_Type + with record + Minimum_Field_Width : Natural := 0; + end record; + + procedure Set_Field_Type (Fld : in Field; + Typ : in Alpha_Field); + pragma Inline (Set_Field_Type); + +end Terminal_Interface.Curses.Forms.Field_Types.Alpha; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb new file mode 100644 index 0000000..3684b8a --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb @@ -0,0 +1,68 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Interfaces.C; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +package body Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric is + + use type Interfaces.C.int; + + procedure Set_Field_Type (Fld : in Field; + Typ : in AlphaNumeric_Field) + is + C_AlphaNumeric_Field_Type : C_Field_Type; + pragma Import (C, C_AlphaNumeric_Field_Type, "TYPE_ALNUM"); + + function Set_Fld_Type (F : Field := Fld; + Cft : C_Field_Type := C_AlphaNumeric_Field_Type; + Arg1 : C_Int) return C_Int; + pragma Import (C, Set_Fld_Type, "set_field_type"); + + Res : Eti_Error; + begin + Res := Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width)); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + Wrap_Builtin (Fld, Typ); + end Set_Field_Type; + +end Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.ads b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.ads new file mode 100644 index 0000000..2e174d6 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.ads @@ -0,0 +1,54 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +package Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric is + pragma Preelaborate + (Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric); + + type AlphaNumeric_Field is new Field_Type + with record + Minimum_Field_Width : Natural := 0; + end record; + + procedure Set_Field_Type (Fld : in Field; + Typ : in AlphaNumeric_Field); + pragma Inline (Set_Field_Type); + +end Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb new file mode 100644 index 0000000..c8ffe58 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb @@ -0,0 +1,80 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Ada.Characters.Handling; use Ada.Characters.Handling; + +package body Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada is + + function Create (Set : Type_Set := Mixed_Case; + Case_Sensitive : Boolean := False; + Must_Be_Unique : Boolean := False) + return Enumeration_Field + is + I : Enumeration_Info (T'Pos (T'Last) - T'Pos (T'First) + 1); + J : Positive := 1; + begin + I.Case_Sensitive := Case_Sensitive; + I.Match_Must_Be_Unique := Must_Be_Unique; + + for E in T'Range loop + I.Names (J) := new String'(T'Image (T (E))); + -- The Image attribute defaults to upper case, so we have to handle + -- only the other ones... + if Set /= Upper_Case then + I.Names (J).all := To_Lower (I.Names (J).all); + if Set = Mixed_Case then + I.Names (J)(I.Names (J).all'First) := + To_Upper (I.Names (J)(I.Names (J).all'First)); + end if; + end if; + J := J + 1; + end loop; + + return Create (I, True); + end Create; + + function Value (Fld : Field; + Buf : Buffer_Number := Buffer_Number'First) return T + is + begin + return T'Value (Get_Buffer (Fld, Buf)); + end Value; + +end Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.ads b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.ads new file mode 100644 index 0000000..6b01c26 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.ads @@ -0,0 +1,59 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +generic + type T is (<>); + +package Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada is + pragma Preelaborate + (Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada); + + function Create (Set : Type_Set := Mixed_Case; + Case_Sensitive : Boolean := False; + Must_Be_Unique : Boolean := False) + return Enumeration_Field; + + function Value (Fld : Field; + Buf : Buffer_Number := Buffer_Number'First) return T; + -- Translate the content of the fields buffer - indicated by the + -- buffer number - into an enumeration value. If the buffer is empty + -- or the content is invalid, a Constraint_Error is raises. + +end Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb new file mode 100644 index 0000000..fccb4f3 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb @@ -0,0 +1,119 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.Enumeration -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Ada.Unchecked_Deallocation; +with Interfaces.C; use Interfaces.C; +with Interfaces.C.Strings; use Interfaces.C.Strings; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +package body Terminal_Interface.Curses.Forms.Field_Types.Enumeration is + + function Create (Info : Enumeration_Info; + Auto_Release_Names : Boolean := False) + return Enumeration_Field + is + procedure Release_String is + new Ada.Unchecked_Deallocation (String, + String_Access); + E : Enumeration_Field; + L : constant size_t := 1 + size_t (Info.C); + S : String_Access; + begin + E.Case_Sensitive := Info.Case_Sensitive; + E.Match_Must_Be_Unique := Info.Match_Must_Be_Unique; + E.Arr := new chars_ptr_array (size_t (1) .. L); + for I in 1 .. Positive (L - 1) loop + if Info.Names (I) = null then + raise Form_Exception; + end if; + E.Arr (size_t (I)) := New_String (Info.Names (I).all); + if Auto_Release_Names then + S := Info.Names (I); + Release_String (S); + end if; + end loop; + E.Arr (L) := Null_Ptr; + return E; + end Create; + + procedure Release (Enum : in out Enumeration_Field) + is + I : size_t := 0; + P : chars_ptr; + begin + loop + P := Enum.Arr (I); + exit when P = Null_Ptr; + Free (P); + Enum.Arr (I) := Null_Ptr; + I := I + 1; + end loop; + Enum.Arr := null; + end Release; + + procedure Set_Field_Type (Fld : in Field; + Typ : in Enumeration_Field) + is + C_Enum_Type : C_Field_Type; + pragma Import (C, C_Enum_Type, "TYPE_ENUM"); + + function Set_Fld_Type (F : Field := Fld; + Cft : C_Field_Type := C_Enum_Type; + Arg1 : chars_ptr_array; + Arg2 : C_Int; + Arg3 : C_Int) return C_Int; + pragma Import (C, Set_Fld_Type, "set_field_type"); + + Res : Eti_Error; + begin + if Typ.Arr = null then + raise Form_Exception; + end if; + Res := Set_Fld_Type (Arg1 => Typ.Arr.all, + Arg2 => C_Int (Boolean'Pos (Typ.Case_Sensitive)), + Arg3 => C_Int (Boolean'Pos + (Typ.Match_Must_Be_Unique))); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + Wrap_Builtin (Fld, Typ, C_Choice_Router); + end Set_Field_Type; + +end Terminal_Interface.Curses.Forms.Field_Types.Enumeration; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads new file mode 100644 index 0000000..d3d54b8 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads @@ -0,0 +1,98 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.Enumeration -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Interfaces.C.Strings; + +package Terminal_Interface.Curses.Forms.Field_Types.Enumeration is + pragma Preelaborate + (Terminal_Interface.Curses.Forms.Field_Types.Enumeration); + + type String_Access is access String; + + -- Type_Set is used by the child package Ada + type Type_Set is (Lower_Case, Upper_Case, Mixed_Case); + + type Enum_Array is array (Positive range <>) + of String_Access; + + type Enumeration_Info (C : Positive) is + record + Names : Enum_Array (1 .. C); + Case_Sensitive : Boolean := False; + Match_Must_Be_Unique : Boolean := False; + end record; + + type Enumeration_Field is new Field_Type with private; + + function Create (Info : Enumeration_Info; + Auto_Release_Names : Boolean := False) + return Enumeration_Field; + -- Make an fieldtype from the info. Enumerations are special, because + -- they normally don't copy the enum values into a private store, so + -- we have to care for the lifetime of the info we provide. + -- The Auto_Release_Names flag may be used to automatically releases + -- the strings in the Names array of the Enumeration_Info. + + function Make_Enumeration_Type (Info : Enumeration_Info; + Auto_Release_Names : Boolean := False) + return Enumeration_Field renames Create; + + procedure Release (Enum : in out Enumeration_Field); + -- But we may want to release the field to release the memory allocated + -- by it internally. After that the Enumeration field is no longer usable. + + -- The next type defintions are all ncurses extensions. They are typically + -- not available in other curses implementations. + + procedure Set_Field_Type (Fld : in Field; + Typ : in Enumeration_Field); + pragma Inline (Set_Field_Type); + +private + type CPA_Access is access Interfaces.C.Strings.chars_ptr_array; + + type Enumeration_Field is new Field_Type with + record + Case_Sensitive : Boolean := False; + Match_Must_Be_Unique : Boolean := False; + Arr : CPA_Access := null; + end record; + +end Terminal_Interface.Curses.Forms.Field_Types.Enumeration; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb new file mode 100644 index 0000000..4607a78 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb @@ -0,0 +1,72 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.IntField -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Interfaces.C; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +package body Terminal_Interface.Curses.Forms.Field_Types.IntField is + + use type Interfaces.C.int; + + procedure Set_Field_Type (Fld : in Field; + Typ : in Integer_Field) + is + C_Integer_Field_Type : C_Field_Type; + pragma Import (C, C_Integer_Field_Type, "TYPE_INTEGER"); + + function Set_Fld_Type (F : Field := Fld; + Cft : C_Field_Type := C_Integer_Field_Type; + Arg1 : C_Int; + Arg2 : C_Long_Int; + Arg3 : C_Long_Int) return C_Int; + pragma Import (C, Set_Fld_Type, "set_field_type"); + + Res : Eti_Error; + begin + Res := Set_Fld_Type (Arg1 => C_Int (Typ.Precision), + Arg2 => C_Long_Int (Typ.Lower_Limit), + Arg3 => C_Long_Int (Typ.Upper_Limit)); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + Wrap_Builtin (Fld, Typ); + end Set_Field_Type; + +end Terminal_Interface.Curses.Forms.Field_Types.IntField; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-intfield.ads b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-intfield.ads new file mode 100644 index 0000000..4ab7903 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-intfield.ads @@ -0,0 +1,55 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.IntField -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +package Terminal_Interface.Curses.Forms.Field_Types.IntField is + pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.IntField); + + type Integer_Field is new Field_Type with + record + Precision : Natural; + Lower_Limit : Integer; + Upper_Limit : Integer; + end record; + + procedure Set_Field_Type (Fld : in Field; + Typ : in Integer_Field); + pragma Inline (Set_Field_Type); + +end Terminal_Interface.Curses.Forms.Field_Types.IntField; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb new file mode 100644 index 0000000..b5ec33a --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb @@ -0,0 +1,68 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Interfaces.C; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +package body Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address is + + use type Interfaces.C.int; + + procedure Set_Field_Type (Fld : in Field; + Typ : in Internet_V4_Address_Field) + is + C_IPV4_Field_Type : C_Field_Type; + pragma Import (C, C_IPV4_Field_Type, "TYPE_IPV4"); + + function Set_Fld_Type (F : Field := Fld; + Cft : C_Field_Type := C_IPV4_Field_Type) + return C_Int; + pragma Import (C, Set_Fld_Type, "set_field_type"); + + Res : Eti_Error; + begin + Res := Set_Fld_Type; + if Res /= E_Ok then + Eti_Exception (Res); + end if; + Wrap_Builtin (Fld, Typ); + end Set_Field_Type; + +end Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.ads b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.ads new file mode 100644 index 0000000..2f91980 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.ads @@ -0,0 +1,51 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +package Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address is + pragma Preelaborate + (Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address); + + type Internet_V4_Address_Field is new Field_Type with null record; + + procedure Set_Field_Type (Fld : in Field; + Typ : in Internet_V4_Address_Field); + pragma Inline (Set_Field_Type); + +end Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb new file mode 100644 index 0000000..4d172f1 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb @@ -0,0 +1,74 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.Numeric -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Interfaces.C; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +package body Terminal_Interface.Curses.Forms.Field_Types.Numeric is + + use type Interfaces.C.int; + + procedure Set_Field_Type (Fld : in Field; + Typ : in Numeric_Field) + is + type Double is new Interfaces.C.double; + + C_Numeric_Field_Type : C_Field_Type; + pragma Import (C, C_Numeric_Field_Type, "TYPE_NUMERIC"); + + function Set_Fld_Type (F : Field := Fld; + Cft : C_Field_Type := C_Numeric_Field_Type; + Arg1 : C_Int; + Arg2 : Double; + Arg3 : Double) return C_Int; + pragma Import (C, Set_Fld_Type, "set_field_type"); + + Res : Eti_Error; + begin + Res := Set_Fld_Type (Arg1 => C_Int (Typ.Precision), + Arg2 => Double (Typ.Lower_Limit), + Arg3 => Double (Typ.Upper_Limit)); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + Wrap_Builtin (Fld, Typ); + end Set_Field_Type; + +end Terminal_Interface.Curses.Forms.Field_Types.Numeric; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-numeric.ads b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-numeric.ads new file mode 100644 index 0000000..0bcf03c --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-numeric.ads @@ -0,0 +1,55 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.Numeric -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +package Terminal_Interface.Curses.Forms.Field_Types.Numeric is + pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.Numeric); + + type Numeric_Field is new Field_Type with + record + Precision : Natural; + Lower_Limit : Float; + Upper_Limit : Float; + end record; + + procedure Set_Field_Type (Fld : in Field; + Typ : in Numeric_Field); + pragma Inline (Set_Field_Type); + +end Terminal_Interface.Curses.Forms.Field_Types.Numeric; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb new file mode 100644 index 0000000..f377e95 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb @@ -0,0 +1,71 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.RegExp -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Interfaces.C; use Interfaces.C; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +package body Terminal_Interface.Curses.Forms.Field_Types.RegExp is + + procedure Set_Field_Type (Fld : in Field; + Typ : in Regular_Expression_Field) + is + type Char_Ptr is access all Interfaces.C.char; + + C_Regexp_Field_Type : C_Field_Type; + pragma Import (C, C_Regexp_Field_Type, "TYPE_REGEXP"); + + function Set_Ftyp (F : Field := Fld; + Cft : C_Field_Type := C_Regexp_Field_Type; + Arg1 : Char_Ptr) return C_Int; + pragma Import (C, Set_Ftyp, "set_field_type"); + + Txt : char_array (0 .. Typ.Regular_Expression.all'Length); + Len : size_t; + Res : Eti_Error; + begin + To_C (Typ.Regular_Expression.all, Txt, Len); + Res := Set_Ftyp (Arg1 => Txt (Txt'First)'Access); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + Wrap_Builtin (Fld, Typ); + end Set_Field_Type; + +end Terminal_Interface.Curses.Forms.Field_Types.RegExp; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-regexp.ads b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-regexp.ads new file mode 100644 index 0000000..ce4c883 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-regexp.ads @@ -0,0 +1,55 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.RegExp -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +package Terminal_Interface.Curses.Forms.Field_Types.RegExp is + pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.RegExp); + + type String_Access is access String; + + type Regular_Expression_Field is new Field_Type with + record + Regular_Expression : String_Access; + end record; + + procedure Set_Field_Type (Fld : in Field; + Typ : in Regular_Expression_Field); + pragma Inline (Set_Field_Type); + +end Terminal_Interface.Curses.Forms.Field_Types.RegExp; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb new file mode 100644 index 0000000..4f8d058 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb @@ -0,0 +1,110 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.User.Choice -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Ada.Unchecked_Conversion; +with Interfaces.C; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +package body Terminal_Interface.Curses.Forms.Field_Types.User.Choice is + + use type Interfaces.C.int; + + function To_Argument_Access is new Ada.Unchecked_Conversion + (System.Address, Argument_Access); + + function Generic_Next (Fld : Field; + Usr : System.Address) return C_Int + is + Result : Boolean; + Udf : User_Defined_Field_Type_With_Choice_Access := + User_Defined_Field_Type_With_Choice_Access + (To_Argument_Access (Usr).Typ); + begin + Result := Next (Fld, Udf.all); + return C_Int (Boolean'Pos (Result)); + end Generic_Next; + + function Generic_Prev (Fld : Field; + Usr : System.Address) return C_Int + is + Result : Boolean; + Udf : User_Defined_Field_Type_With_Choice_Access := + User_Defined_Field_Type_With_Choice_Access + (To_Argument_Access (Usr).Typ); + begin + Result := Previous (Fld, Udf.all); + return C_Int (Boolean'Pos (Result)); + end Generic_Prev; + + -- ----------------------------------------------------------------------- + -- + function C_Generic_Choice return C_Field_Type + is + Res : Eti_Error; + T : C_Field_Type; + begin + if M_Generic_Choice = Null_Field_Type then + T := New_Fieldtype (Generic_Field_Check'Access, + Generic_Char_Check'Access); + if T = Null_Field_Type then + raise Form_Exception; + else + Res := Set_Fieldtype_Arg (T, + Make_Arg'Access, + Copy_Arg'Access, + Free_Arg'Access); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + + Res := Set_Fieldtype_Choice (T, + Generic_Next'Access, + Generic_Prev'Access); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end if; + M_Generic_Choice := T; + end if; + pragma Assert (M_Generic_Choice /= Null_Field_Type); + return M_Generic_Choice; + end C_Generic_Choice; + +end Terminal_Interface.Curses.Forms.Field_Types.User.Choice; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads new file mode 100644 index 0000000..9f1ba10 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads @@ -0,0 +1,96 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.User.Choice -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Interfaces.C; + +package Terminal_Interface.Curses.Forms.Field_Types.User.Choice is + pragma Preelaborate + (Terminal_Interface.Curses.Forms.Field_Types.User.Choice); + + use type Interfaces.C.int; + subtype C_Int is Interfaces.C.int; + + type User_Defined_Field_Type_With_Choice is abstract new + User_Defined_Field_Type with null record; + -- This is the root of the mechanism we use to create field types in + -- Ada95 that allow the prev/next mechanism. You should your own type + -- derive from this one and implement the Field_Check, Character_Check + -- Next and Previous functions for your own type. + + type User_Defined_Field_Type_With_Choice_Access is access all + User_Defined_Field_Type_With_Choice'Class; + + function Next + (Fld : Field; + Typ : User_Defined_Field_Type_With_Choice) return Boolean + is abstract; + -- If True is returned, the function successfully generated a next + -- value into the fields buffer. + + function Previous + (Fld : Field; + Typ : User_Defined_Field_Type_With_Choice) return Boolean + is abstract; + -- If True is returned, the function successfully generated a previous + -- value into the fields buffer. + + -- +---------------------------------------------------------------------- + -- | Private Part. + -- | +private + use type Interfaces.C.int; + + function C_Generic_Choice return C_Field_Type; + + function Generic_Next (Fld : Field; + Usr : System.Address) return C_Int; + pragma Convention (C, Generic_Next); + -- This is the generic next Choice_Function for the low-level fieldtype + -- representing all the User_Defined_Field_Type derivates. It routes + -- the call to the Next implementation for the type. + + function Generic_Prev (Fld : Field; + Usr : System.Address) return C_Int; + pragma Convention (C, Generic_Prev); + -- This is the generic prev Choice_Function for the low-level fieldtype + -- representing all the User_Defined_Field_Type derivates. It routes + -- the call to the Previous implementation for the type. + +end Terminal_Interface.Curses.Forms.Field_Types.User.Choice; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-user.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-user.adb new file mode 100644 index 0000000..b011c5f --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-user.adb @@ -0,0 +1,132 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.User -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Ada.Unchecked_Conversion; +with Interfaces.C; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +package body Terminal_Interface.Curses.Forms.Field_Types.User is + + use type Interfaces.C.int; + + procedure Set_Field_Type (Fld : in Field; + Typ : in User_Defined_Field_Type) + is + function Allocate_Arg (T : User_Defined_Field_Type'Class) + return Argument_Access; + + function Set_Fld_Type (F : Field := Fld; + Cft : C_Field_Type := C_Generic_Type; + Arg1 : Argument_Access) + return C_Int; + pragma Import (C, Set_Fld_Type, "set_field_type"); + + Res : Eti_Error; + + function Allocate_Arg (T : User_Defined_Field_Type'Class) + return Argument_Access + is + Ptr : Field_Type_Access := new User_Defined_Field_Type'Class'(T); + begin + return new Argument'(Usr => System.Null_Address, + Typ => Ptr, + Cft => Null_Field_Type); + end Allocate_Arg; + + begin + Res := Set_Fld_Type (Arg1 => Allocate_Arg (Typ)); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Field_Type; + + function To_Argument_Access is new Ada.Unchecked_Conversion + (System.Address, Argument_Access); + + function Generic_Field_Check (Fld : Field; + Usr : System.Address) return C_Int + is + Result : Boolean; + Udf : User_Defined_Field_Type_Access := + User_Defined_Field_Type_Access (To_Argument_Access (Usr).Typ); + begin + Result := Field_Check (Fld, Udf.all); + return C_Int (Boolean'Pos (Result)); + end Generic_Field_Check; + + function Generic_Char_Check (Ch : C_Int; + Usr : System.Address) return C_Int + is + Result : Boolean; + Udf : User_Defined_Field_Type_Access := + User_Defined_Field_Type_Access (To_Argument_Access (Usr).Typ); + begin + Result := Character_Check (Character'Val (Ch), Udf.all); + return C_Int (Boolean'Pos (Result)); + end Generic_Char_Check; + + -- ----------------------------------------------------------------------- + -- + function C_Generic_Type return C_Field_Type + is + Res : Eti_Error; + T : C_Field_Type; + begin + if M_Generic_Type = Null_Field_Type then + T := New_Fieldtype (Generic_Field_Check'Access, + Generic_Char_Check'Access); + if T = Null_Field_Type then + raise Form_Exception; + else + Res := Set_Fieldtype_Arg (T, + Make_Arg'Access, + Copy_Arg'Access, + Free_Arg'Access); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end if; + M_Generic_Type := T; + end if; + pragma Assert (M_Generic_Type /= Null_Field_Type); + return M_Generic_Type; + end C_Generic_Type; + +end Terminal_Interface.Curses.Forms.Field_Types.User; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-user.ads b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-user.ads new file mode 100644 index 0000000..a138d2d --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types-user.ads @@ -0,0 +1,97 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.User -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Interfaces.C; + +package Terminal_Interface.Curses.Forms.Field_Types.User is + pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.User); + use type Interfaces.C.int; + subtype C_Int is Interfaces.C.int; + + type User_Defined_Field_Type is abstract new Field_Type with null record; + -- This is the root of the mechanism we use to create field types in + -- Ada95. You should your own type derive from this one and implement + -- the Field_Check and Character_Check functions for your own type. + + type User_Defined_Field_Type_Access is access all + User_Defined_Field_Type'Class; + + function Field_Check + (Fld : Field; + Typ : User_Defined_Field_Type) return Boolean + is abstract; + -- If True is returned, the field is considered valid, otherwise it is + -- invalid. + + function Character_Check + (Ch : Character; + Typ : User_Defined_Field_Type) return Boolean + is abstract; + -- If True is returned, the character is considered as valid for the + -- field, otherwise as invalid. + + procedure Set_Field_Type (Fld : in Field; + Typ : in User_Defined_Field_Type); + -- This should work for all types derived from User_Defined_Field_Type. + -- No need to reimplement it for your derived type. + + -- +---------------------------------------------------------------------- + -- | Private Part. + -- | Used by the Choice child package. +private + use type Interfaces.C.int; + + function C_Generic_Type return C_Field_Type; + + function Generic_Field_Check (Fld : Field; + Usr : System.Address) return C_Int; + pragma Convention (C, Generic_Field_Check); + -- This is the generic Field_Check_Function for the low-level fieldtype + -- representing all the User_Defined_Field_Type derivates. It routes + -- the call to the Field_Check implementation for the type. + + function Generic_Char_Check (Ch : C_Int; + Usr : System.Address) return C_Int; + pragma Convention (C, Generic_Char_Check); + -- This is the generic Char_Check_Function for the low-level fieldtype + -- representing all the User_Defined_Field_Type derivates. It routes + -- the call to the Character_Check implementation for the type. + +end Terminal_Interface.Curses.Forms.Field_Types.User; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types.adb new file mode 100644 index 0000000..da223c9 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_types.adb @@ -0,0 +1,296 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Interfaces.C; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Ada.Unchecked_Deallocation; +with Ada.Unchecked_Conversion; +-- | +-- |===================================================================== +-- | man page form_fieldtype.3x +-- |===================================================================== +-- | +package body Terminal_Interface.Curses.Forms.Field_Types is + + use type Interfaces.C.int; + use type System.Address; + + function To_Argument_Access is new Ada.Unchecked_Conversion + (System.Address, Argument_Access); + + function Get_Fieldtype (F : Field) return C_Field_Type; + pragma Import (C, Get_Fieldtype, "field_type"); + + function Get_Arg (F : Field) return System.Address; + pragma Import (C, Get_Arg, "field_arg"); + -- | + -- |===================================================================== + -- | man page form_field_validation.3x + -- |===================================================================== + -- | + -- | + -- | + function Get_Type (Fld : in Field) return Field_Type_Access + is + Low_Level : constant C_Field_Type := Get_Fieldtype (Fld); + Arg : Argument_Access; + begin + if Low_Level = Null_Field_Type then + return null; + else + if Low_Level = M_Builtin_Router or else + Low_Level = M_Generic_Type or else + Low_Level = M_Choice_Router or else + Low_Level = M_Generic_Choice then + Arg := To_Argument_Access (Get_Arg (Fld)); + if Arg = null then + raise Form_Exception; + else + return Arg.Typ; + end if; + else + raise Form_Exception; + end if; + end if; + end Get_Type; + + function Make_Arg (Args : System.Address) return System.Address + is + -- Actually args is a double indirected pointer to the arguments + -- of a C variable argument list. In theory it is now quite + -- complicated to write portable routine that reads the arguments, + -- because one has to know the growth direction of the stack and + -- the sizes of the individual arguments. + -- Fortunately we are only interested in the first argument (#0), + -- we know its size and for the first arg we don't care about + -- into which stack direction we have to proceed. We simply + -- resolve the double indirection and thats it. + type V is access all System.Address; + function To_Access is new Ada.Unchecked_Conversion (System.Address, + V); + begin + return To_Access (To_Access (Args).all).all; + end Make_Arg; + + function Copy_Arg (Usr : System.Address) return System.Address + is + begin + return Usr; + end Copy_Arg; + + procedure Free_Arg (Usr : in System.Address) + is + procedure Free_Type is new Ada.Unchecked_Deallocation + (Field_Type'Class, Field_Type_Access); + procedure Freeargs is new Ada.Unchecked_Deallocation + (Argument, Argument_Access); + + To_Be_Free : Argument_Access := To_Argument_Access (Usr); + Low_Level : C_Field_Type; + begin + if To_Be_Free /= null then + if To_Be_Free.Usr /= System.Null_Address then + Low_Level := To_Be_Free.Cft; + if Low_Level.Freearg /= null then + Low_Level.Freearg (To_Be_Free.Usr); + end if; + end if; + if To_Be_Free.Typ /= null then + Free_Type (To_Be_Free.Typ); + end if; + Freeargs (To_Be_Free); + end if; + end Free_Arg; + + + procedure Wrap_Builtin (Fld : Field; + Typ : Field_Type'Class; + Cft : C_Field_Type := C_Builtin_Router) + is + Usr_Arg : System.Address := Get_Arg (Fld); + Low_Level : constant C_Field_Type := Get_Fieldtype (Fld); + Arg : Argument_Access; + Res : Eti_Error; + function Set_Fld_Type (F : Field := Fld; + Cf : C_Field_Type := Cft; + Arg1 : Argument_Access) return C_Int; + pragma Import (C, Set_Fld_Type, "set_field_type"); + + begin + pragma Assert (Low_Level /= Null_Field_Type); + if Cft /= C_Builtin_Router and then Cft /= C_Choice_Router then + raise Form_Exception; + else + Arg := new Argument'(Usr => System.Null_Address, + Typ => new Field_Type'Class'(Typ), + Cft => Get_Fieldtype (Fld)); + if Usr_Arg /= System.Null_Address then + if Low_Level.Copyarg /= null then + Arg.Usr := Low_Level.Copyarg (Usr_Arg); + else + Arg.Usr := Usr_Arg; + end if; + end if; + + Res := Set_Fld_Type (Arg1 => Arg); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end if; + end Wrap_Builtin; + + function Field_Check_Router (Fld : Field; + Usr : System.Address) return C_Int + is + Arg : constant Argument_Access := To_Argument_Access (Usr); + begin + pragma Assert (Arg /= null and then Arg.Cft /= Null_Field_Type + and then Arg.Typ /= null); + if Arg.Cft.Fcheck /= null then + return Arg.Cft.Fcheck (Fld, Arg.Usr); + else + return 1; + end if; + end Field_Check_Router; + + function Char_Check_Router (Ch : C_Int; + Usr : System.Address) return C_Int + is + Arg : constant Argument_Access := To_Argument_Access (Usr); + begin + pragma Assert (Arg /= null and then Arg.Cft /= Null_Field_Type + and then Arg.Typ /= null); + if Arg.Cft.Ccheck /= null then + return Arg.Cft.Ccheck (Ch, Arg.Usr); + else + return 1; + end if; + end Char_Check_Router; + + function Next_Router (Fld : Field; + Usr : System.Address) return C_Int + is + Arg : constant Argument_Access := To_Argument_Access (Usr); + begin + pragma Assert (Arg /= null and then Arg.Cft /= Null_Field_Type + and then Arg.Typ /= null); + if Arg.Cft.Next /= null then + return Arg.Cft.Next (Fld, Arg.Usr); + else + return 1; + end if; + end Next_Router; + + function Prev_Router (Fld : Field; + Usr : System.Address) return C_Int + is + Arg : constant Argument_Access := To_Argument_Access (Usr); + begin + pragma Assert (Arg /= null and then Arg.Cft /= Null_Field_Type + and then Arg.Typ /= null); + if Arg.Cft.Prev /= null then + return Arg.Cft.Prev (Fld, Arg.Usr); + else + return 1; + end if; + end Prev_Router; + + -- ----------------------------------------------------------------------- + -- + function C_Builtin_Router return C_Field_Type + is + Res : Eti_Error; + T : C_Field_Type; + begin + if M_Builtin_Router = Null_Field_Type then + T := New_Fieldtype (Field_Check_Router'Access, + Char_Check_Router'Access); + if T = Null_Field_Type then + raise Form_Exception; + else + Res := Set_Fieldtype_Arg (T, + Make_Arg'Access, + Copy_Arg'Access, + Free_Arg'Access); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end if; + M_Builtin_Router := T; + end if; + pragma Assert (M_Builtin_Router /= Null_Field_Type); + return M_Builtin_Router; + end C_Builtin_Router; + + -- ----------------------------------------------------------------------- + -- + function C_Choice_Router return C_Field_Type + is + Res : Eti_Error; + T : C_Field_Type; + begin + if M_Choice_Router = Null_Field_Type then + T := New_Fieldtype (Field_Check_Router'Access, + Char_Check_Router'Access); + if T = Null_Field_Type then + raise Form_Exception; + else + Res := Set_Fieldtype_Arg (T, + Make_Arg'Access, + Copy_Arg'Access, + Free_Arg'Access); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + + Res := Set_Fieldtype_Choice (T, + Next_Router'Access, + Prev_Router'Access); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end if; + M_Choice_Router := T; + end if; + pragma Assert (M_Choice_Router /= Null_Field_Type); + return M_Choice_Router; + end C_Choice_Router; + +end Terminal_Interface.Curses.Forms.Field_Types; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_user_data.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_user_data.adb new file mode 100644 index 0000000..82d8f71 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-field_user_data.adb @@ -0,0 +1,85 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_User_Data -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +-- | +-- |===================================================================== +-- | man page form_field_userptr.3x +-- |===================================================================== +-- | +package body Terminal_Interface.Curses.Forms.Field_User_Data is + -- | + -- | + -- | + use type Interfaces.C.int; + + procedure Set_User_Data (Fld : in Field; + Data : in User_Access) + is + function Set_Field_Userptr (Fld : Field; + Usr : User_Access) return C_Int; + pragma Import (C, Set_Field_Userptr, "set_field_userptr"); + + Res : constant Eti_Error := Set_Field_Userptr (Fld, Data); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_User_Data; + -- | + -- | + -- | + function Get_User_Data (Fld : in Field) return User_Access + is + function Field_Userptr (Fld : Field) return User_Access; + pragma Import (C, Field_Userptr, "field_userptr"); + begin + return Field_Userptr (Fld); + end Get_User_Data; + + procedure Get_User_Data (Fld : in Field; + Data : out User_Access) + is + begin + Data := Get_User_Data (Fld); + end Get_User_Data; + +end Terminal_Interface.Curses.Forms.Field_User_Data; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-form_user_data.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-form_user_data.adb new file mode 100644 index 0000000..b4c0ffc --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms-form_user_data.adb @@ -0,0 +1,86 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Form_User_Data -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +-- | +-- |===================================================================== +-- | man page form__userptr.3x +-- |===================================================================== +-- | +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +package body Terminal_Interface.Curses.Forms.Form_User_Data is + + use type Interfaces.C.int; + + -- | + -- | + -- | + procedure Set_User_Data (Frm : in Form; + Data : in User_Access) + is + function Set_Form_Userptr (Frm : Form; + Data : User_Access) return C_Int; + pragma Import (C, Set_Form_Userptr, "set_form_userptr"); + + Res : constant Eti_Error := Set_Form_Userptr (Frm, Data); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_User_Data; + -- | + -- | + -- | + function Get_User_Data (Frm : in Form) return User_Access + is + function Form_Userptr (Frm : Form) return User_Access; + pragma Import (C, Form_Userptr, "form_userptr"); + begin + return Form_Userptr (Frm); + end Get_User_Data; + + procedure Get_User_Data (Frm : in Form; + Data : out User_Access) + is + begin + Data := Get_User_Data (Frm); + end Get_User_Data; + +end Terminal_Interface.Curses.Forms.Form_User_Data; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-forms.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms.adb new file mode 100644 index 0000000..6c592d8 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-forms.adb @@ -0,0 +1,1160 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Ada.Unchecked_Deallocation; +with Ada.Unchecked_Conversion; + +with Interfaces.C; use Interfaces.C; +with Interfaces.C.Strings; use Interfaces.C.Strings; +with Interfaces.C.Pointers; + +with Terminal_Interface.Curses.Aux; + +package body Terminal_Interface.Curses.Forms is + + use Terminal_Interface.Curses.Aux; + + type C_Field_Array is array (Natural range <>) of aliased Field; + package F_Array is new + Interfaces.C.Pointers (Natural, Field, C_Field_Array, Null_Field); + +------------------------------------------------------------------------------ + -- | + -- | + -- | + -- subtype chars_ptr is Interfaces.C.Strings.chars_ptr; + + function FOS_2_CInt is new + Ada.Unchecked_Conversion (Field_Option_Set, + C_Int); + + function CInt_2_FOS is new + Ada.Unchecked_Conversion (C_Int, + Field_Option_Set); + + function FrmOS_2_CInt is new + Ada.Unchecked_Conversion (Form_Option_Set, + C_Int); + + function CInt_2_FrmOS is new + Ada.Unchecked_Conversion (C_Int, + Form_Option_Set); + + procedure Request_Name (Key : in Form_Request_Code; + Name : out String) + is + function Form_Request_Name (Key : C_Int) return chars_ptr; + pragma Import (C, Form_Request_Name, "form_request_name"); + begin + Fill_String (Form_Request_Name (C_Int (Key)), Name); + end Request_Name; + + function Request_Name (Key : Form_Request_Code) return String + is + function Form_Request_Name (Key : C_Int) return chars_ptr; + pragma Import (C, Form_Request_Name, "form_request_name"); + begin + return Fill_String (Form_Request_Name (C_Int (Key))); + end Request_Name; +------------------------------------------------------------------------------ + -- | + -- | + -- | + -- | + -- |===================================================================== + -- | man page form_field_new.3x + -- |===================================================================== + -- | + -- | + -- | + function Create (Height : Line_Count; + Width : Column_Count; + Top : Line_Position; + Left : Column_Position; + Off_Screen : Natural := 0; + More_Buffers : Buffer_Number := Buffer_Number'First) + return Field + is + function Newfield (H, W, T, L, O, M : C_Int) return Field; + pragma Import (C, Newfield, "new_field"); + Fld : constant Field := Newfield (C_Int (Height), C_Int (Width), + C_Int (Top), C_Int (Left), + C_Int (Off_Screen), + C_Int (More_Buffers)); + begin + if Fld = Null_Field then + raise Form_Exception; + end if; + return Fld; + end Create; +-- | +-- | +-- | + procedure Delete (Fld : in out Field) + is + function Free_Field (Fld : Field) return C_Int; + pragma Import (C, Free_Field, "free_field"); + + Res : Eti_Error; + begin + Res := Free_Field (Fld); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + Fld := Null_Field; + end Delete; + -- | + -- | + -- | + function Duplicate (Fld : Field; + Top : Line_Position; + Left : Column_Position) return Field + is + function Dup_Field (Fld : Field; + Top : C_Int; + Left : C_Int) return Field; + pragma Import (C, Dup_Field, "dup_field"); + + F : constant Field := Dup_Field (Fld, + C_Int (Top), + C_Int (Left)); + begin + if F = Null_Field then + raise Form_Exception; + end if; + return F; + end Duplicate; + -- | + -- | + -- | + function Link (Fld : Field; + Top : Line_Position; + Left : Column_Position) return Field + is + function Lnk_Field (Fld : Field; + Top : C_Int; + Left : C_Int) return Field; + pragma Import (C, Lnk_Field, "link_field"); + + F : constant Field := Lnk_Field (Fld, + C_Int (Top), + C_Int (Left)); + begin + if F = Null_Field then + raise Form_Exception; + end if; + return F; + end Link; + -- | + -- |===================================================================== + -- | man page form_field_just.3x + -- |===================================================================== + -- | + -- | + -- | + procedure Set_Justification (Fld : in Field; + Just : in Field_Justification := None) + is + function Set_Field_Just (Fld : Field; + Just : C_Int) return C_Int; + pragma Import (C, Set_Field_Just, "set_field_just"); + + Res : constant Eti_Error := + Set_Field_Just (Fld, + C_Int (Field_Justification'Pos (Just))); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Justification; + -- | + -- | + -- | + function Get_Justification (Fld : Field) return Field_Justification + is + function Field_Just (Fld : Field) return C_Int; + pragma Import (C, Field_Just, "field_just"); + begin + return Field_Justification'Val (Field_Just (Fld)); + end Get_Justification; + -- | + -- |===================================================================== + -- | man page form_field_buffer.3x + -- |===================================================================== + -- | + -- | + -- | + procedure Set_Buffer + (Fld : in Field; + Buffer : in Buffer_Number := Buffer_Number'First; + Str : in String) + is + type Char_Ptr is access all Interfaces.C.char; + function Set_Fld_Buffer (Fld : Field; + Bufnum : C_Int; + S : Char_Ptr) + return C_Int; + pragma Import (C, Set_Fld_Buffer, "set_field_buffer"); + + Txt : char_array (0 .. Str'Length); + Len : size_t; + Res : Eti_Error; + begin + To_C (Str, Txt, Len); + Res := Set_Fld_Buffer (Fld, C_Int (Buffer), Txt (Txt'First)'Access); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Buffer; + -- | + -- | + -- | + procedure Get_Buffer + (Fld : in Field; + Buffer : in Buffer_Number := Buffer_Number'First; + Str : out String) + is + function Field_Buffer (Fld : Field; + B : C_Int) return chars_ptr; + pragma Import (C, Field_Buffer, "field_buffer"); + begin + Fill_String (Field_Buffer (Fld, C_Int (Buffer)), Str); + end Get_Buffer; + + function Get_Buffer + (Fld : in Field; + Buffer : in Buffer_Number := Buffer_Number'First) return String + is + function Field_Buffer (Fld : Field; + B : C_Int) return chars_ptr; + pragma Import (C, Field_Buffer, "field_buffer"); + begin + return Fill_String (Field_Buffer (Fld, C_Int (Buffer))); + end Get_Buffer; + -- | + -- | + -- | + procedure Set_Status (Fld : in Field; + Status : in Boolean := True) + is + function Set_Fld_Status (Fld : Field; + St : C_Int) return C_Int; + pragma Import (C, Set_Fld_Status, "set_field_status"); + + Res : constant Eti_Error := Set_Fld_Status (Fld, Boolean'Pos (Status)); + begin + if Res /= E_Ok then + raise Form_Exception; + end if; + end Set_Status; + -- | + -- | + -- | + function Changed (Fld : Field) return Boolean + is + function Field_Status (Fld : Field) return C_Int; + pragma Import (C, Field_Status, "field_status"); + + Res : constant C_Int := Field_Status (Fld); + begin + if Res = Curses_False then + return False; + else + return True; + end if; + end Changed; + -- | + -- | + -- | + procedure Set_Maximum_Size (Fld : in Field; + Max : in Natural := 0) + is + function Set_Field_Max (Fld : Field; + M : C_Int) return C_Int; + pragma Import (C, Set_Field_Max, "set_max_field"); + + Res : constant Eti_Error := Set_Field_Max (Fld, C_Int (Max)); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Maximum_Size; + -- | + -- |===================================================================== + -- | man page form_field_opts.3x + -- |===================================================================== + -- | + -- | + -- | + procedure Set_Options (Fld : in Field; + Options : in Field_Option_Set) + is + function Set_Field_Opts (Fld : Field; + Opt : C_Int) return C_Int; + pragma Import (C, Set_Field_Opts, "set_field_opts"); + + Opt : C_Int := FOS_2_CInt (Options); + Res : Eti_Error; + begin + Res := Set_Field_Opts (Fld, Opt); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Options; + -- | + -- | + -- | + procedure Switch_Options (Fld : in Field; + Options : in Field_Option_Set; + On : Boolean := True) + is + function Field_Opts_On (Fld : Field; + Opt : C_Int) return C_Int; + pragma Import (C, Field_Opts_On, "field_opts_on"); + function Field_Opts_Off (Fld : Field; + Opt : C_Int) return C_Int; + pragma Import (C, Field_Opts_Off, "field_opts_off"); + + Err : Eti_Error; + Opt : C_Int := FOS_2_CInt (Options); + begin + if On then + Err := Field_Opts_On (Fld, Opt); + else + Err := Field_Opts_Off (Fld, Opt); + end if; + if Err /= E_Ok then + Eti_Exception (Err); + end if; + end Switch_Options; + -- | + -- | + -- | + procedure Get_Options (Fld : in Field; + Options : out Field_Option_Set) + is + function Field_Opts (Fld : Field) return C_Int; + pragma Import (C, Field_Opts, "field_opts"); + + Res : C_Int := Field_Opts (Fld); + begin + Options := CInt_2_FOS (Res); + end Get_Options; + -- | + -- | + -- | + function Get_Options (Fld : Field := Null_Field) + return Field_Option_Set + is + Fos : Field_Option_Set; + begin + Get_Options (Fld, Fos); + return Fos; + end Get_Options; + -- | + -- |===================================================================== + -- | man page form_field_attributes.3x + -- |===================================================================== + -- | + -- | + -- | + procedure Set_Foreground + (Fld : in Field; + Fore : in Character_Attribute_Set := Normal_Video; + Color : in Color_Pair := Color_Pair'First) + is + function Set_Field_Fore (Fld : Field; + Attr : C_Chtype) return C_Int; + pragma Import (C, Set_Field_Fore, "set_field_fore"); + + Ch : constant Attributed_Character := (Ch => Character'First, + Color => Color, + Attr => Fore); + Res : constant Eti_Error := + Set_Field_Fore (Fld, AttrChar_To_Chtype (Ch)); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Foreground; + -- | + -- | + -- | + procedure Foreground (Fld : in Field; + Fore : out Character_Attribute_Set) + is + function Field_Fore (Fld : Field) return C_Chtype; + pragma Import (C, Field_Fore, "field_fore"); + begin + Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr; + end Foreground; + + procedure Foreground (Fld : in Field; + Fore : out Character_Attribute_Set; + Color : out Color_Pair) + is + function Field_Fore (Fld : Field) return C_Chtype; + pragma Import (C, Field_Fore, "field_fore"); + begin + Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr; + Color := Chtype_To_AttrChar (Field_Fore (Fld)).Color; + end Foreground; + -- | + -- | + -- | + procedure Set_Background + (Fld : in Field; + Back : in Character_Attribute_Set := Normal_Video; + Color : in Color_Pair := Color_Pair'First) + is + function Set_Field_Back (Fld : Field; + Attr : C_Chtype) return C_Int; + pragma Import (C, Set_Field_Back, "set_field_back"); + + Ch : constant Attributed_Character := (Ch => Character'First, + Color => Color, + Attr => Back); + Res : constant Eti_Error := + Set_Field_Back (Fld, AttrChar_To_Chtype (Ch)); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Background; + -- | + -- | + -- | + procedure Background (Fld : in Field; + Back : out Character_Attribute_Set) + is + function Field_Back (Fld : Field) return C_Chtype; + pragma Import (C, Field_Back, "field_back"); + begin + Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr; + end Background; + + procedure Background (Fld : in Field; + Back : out Character_Attribute_Set; + Color : out Color_Pair) + is + function Field_Back (Fld : Field) return C_Chtype; + pragma Import (C, Field_Back, "field_back"); + begin + Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr; + Color := Chtype_To_AttrChar (Field_Back (Fld)).Color; + end Background; + -- | + -- | + -- | + procedure Set_Pad_Character (Fld : in Field; + Pad : in Character := Space) + is + function Set_Field_Pad (Fld : Field; + Ch : C_Int) return C_Int; + pragma Import (C, Set_Field_Pad, "set_field_pad"); + + Res : constant Eti_Error := Set_Field_Pad (Fld, + C_Int (Character'Pos (Pad))); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Pad_Character; + -- | + -- | + -- | + procedure Pad_Character (Fld : in Field; + Pad : out Character) + is + function Field_Pad (Fld : Field) return C_Int; + pragma Import (C, Field_Pad, "field_pad"); + begin + Pad := Character'Val (Field_Pad (Fld)); + end Pad_Character; + -- | + -- |===================================================================== + -- | man page form_field_info.3x + -- |===================================================================== + -- | + -- | + -- | + procedure Info (Fld : in Field; + Lines : out Line_Count; + Columns : out Column_Count; + First_Row : out Line_Position; + First_Column : out Column_Position; + Off_Screen : out Natural; + Additional_Buffers : out Buffer_Number) + is + type C_Int_Access is access all C_Int; + function Fld_Info (Fld : Field; + L, C, Fr, Fc, Os, Ab : C_Int_Access) + return C_Int; + pragma Import (C, Fld_Info, "field_info"); + + L, C, Fr, Fc, Os, Ab : aliased C_Int; + Res : constant Eti_Error := Fld_Info (Fld, + L'Access, C'Access, + Fr'Access, Fc'Access, + Os'Access, Ab'Access); + begin + if Res /= E_Ok then + Eti_Exception (Res); + else + Lines := Line_Count (L); + Columns := Column_Count (C); + First_Row := Line_Position (Fr); + First_Column := Column_Position (Fc); + Off_Screen := Natural (Os); + Additional_Buffers := Buffer_Number (Ab); + end if; + end Info; +-- | +-- | +-- | + procedure Dynamic_Info (Fld : in Field; + Lines : out Line_Count; + Columns : out Column_Count; + Max : out Natural) + is + type C_Int_Access is access all C_Int; + function Dyn_Info (Fld : Field; L, C, M : C_Int_Access) return C_Int; + pragma Import (C, Dyn_Info, "dynamic_field_info"); + + L, C, M : aliased C_Int; + Res : constant Eti_Error := Dyn_Info (Fld, + L'Access, C'Access, + M'Access); + begin + if Res /= E_Ok then + Eti_Exception (Res); + else + Lines := Line_Count (L); + Columns := Column_Count (C); + Max := Natural (M); + end if; + end Dynamic_Info; + -- | + -- |===================================================================== + -- | man page form_win.3x + -- |===================================================================== + -- | + -- | + -- | + procedure Set_Window (Frm : in Form; + Win : in Window) + is + function Set_Form_Win (Frm : Form; + Win : Window) return C_Int; + pragma Import (C, Set_Form_Win, "set_form_win"); + + Res : constant Eti_Error := Set_Form_Win (Frm, Win); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Window; + -- | + -- | + -- | + function Get_Window (Frm : Form) return Window + is + function Form_Win (Frm : Form) return Window; + pragma Import (C, Form_Win, "form_win"); + + W : constant Window := Form_Win (Frm); + begin + return W; + end Get_Window; + -- | + -- | + -- | + procedure Set_Sub_Window (Frm : in Form; + Win : in Window) + is + function Set_Form_Sub (Frm : Form; + Win : Window) return C_Int; + pragma Import (C, Set_Form_Sub, "set_form_sub"); + + Res : constant Eti_Error := Set_Form_Sub (Frm, Win); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Sub_Window; + -- | + -- | + -- | + function Get_Sub_Window (Frm : Form) return Window + is + function Form_Sub (Frm : Form) return Window; + pragma Import (C, Form_Sub, "form_sub"); + + W : constant Window := Form_Sub (Frm); + begin + return W; + end Get_Sub_Window; + -- | + -- | + -- | + procedure Scale (Frm : in Form; + Lines : out Line_Count; + Columns : out Column_Count) + is + type C_Int_Access is access all C_Int; + function M_Scale (Frm : Form; Yp, Xp : C_Int_Access) return C_Int; + pragma Import (C, M_Scale, "scale_form"); + + X, Y : aliased C_Int; + Res : constant Eti_Error := M_Scale (Frm, Y'Access, X'Access); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + Lines := Line_Count (Y); + Columns := Column_Count (X); + end Scale; + -- | + -- |===================================================================== + -- | man page menu_hook.3x + -- |===================================================================== + -- | + -- | + -- | + procedure Set_Field_Init_Hook (Frm : in Form; + Proc : in Form_Hook_Function) + is + function Set_Field_Init (Frm : Form; + Proc : Form_Hook_Function) return C_Int; + pragma Import (C, Set_Field_Init, "set_field_init"); + + Res : constant Eti_Error := Set_Field_Init (Frm, Proc); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Field_Init_Hook; + -- | + -- | + -- | + procedure Set_Field_Term_Hook (Frm : in Form; + Proc : in Form_Hook_Function) + is + function Set_Field_Term (Frm : Form; + Proc : Form_Hook_Function) return C_Int; + pragma Import (C, Set_Field_Term, "set_field_term"); + + Res : constant Eti_Error := Set_Field_Term (Frm, Proc); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Field_Term_Hook; + -- | + -- | + -- | + procedure Set_Form_Init_Hook (Frm : in Form; + Proc : in Form_Hook_Function) + is + function Set_Form_Init (Frm : Form; + Proc : Form_Hook_Function) return C_Int; + pragma Import (C, Set_Form_Init, "set_form_init"); + + Res : constant Eti_Error := Set_Form_Init (Frm, Proc); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Form_Init_Hook; + -- | + -- | + -- | + procedure Set_Form_Term_Hook (Frm : in Form; + Proc : in Form_Hook_Function) + is + function Set_Form_Term (Frm : Form; + Proc : Form_Hook_Function) return C_Int; + pragma Import (C, Set_Form_Term, "set_form_term"); + + Res : constant Eti_Error := Set_Form_Term (Frm, Proc); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Form_Term_Hook; + -- | + -- |===================================================================== + -- | man page form_fields.3x + -- |===================================================================== + -- | + -- | + -- | + procedure Redefine (Frm : in Form; + Flds : in Field_Array_Access) + is + function Set_Frm_Fields (Frm : Form; + Items : System.Address) return C_Int; + pragma Import (C, Set_Frm_Fields, "set_form_fields"); + + Res : Eti_Error; + begin + pragma Assert (Flds (Flds'Last) = Null_Field); + if Flds (Flds'Last) /= Null_Field then + raise Form_Exception; + else + Res := Set_Frm_Fields (Frm, Flds (Flds'First)'Address); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end if; + end Redefine; + -- | + -- | + -- | + function Fields (Frm : Form; + Index : Positive) return Field + is + use F_Array; + + function C_Fields (Frm : Form) return Pointer; + pragma Import (C, C_Fields, "form_fields"); + + P : Pointer := C_Fields (Frm); + begin + if P = null or else Index not in 1 .. Field_Count (Frm) then + raise Form_Exception; + else + P := P + ptrdiff_t (C_Int (Index) - 1); + return P.all; + end if; + end Fields; + -- | + -- | + -- | + function Field_Count (Frm : Form) return Natural + is + function Count (Frm : Form) return C_Int; + pragma Import (C, Count, "field_count"); + begin + return Natural (Count (Frm)); + end Field_Count; + -- | + -- | + -- | + procedure Move (Fld : in Field; + Line : in Line_Position; + Column : in Column_Position) + is + function Move (Fld : Field; L, C : C_Int) return C_Int; + pragma Import (C, Move, "move_field"); + + Res : constant Eti_Error := Move (Fld, C_Int (Line), C_Int (Column)); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Move; + -- | + -- |===================================================================== + -- | man page form_new.3x + -- |===================================================================== + -- | + -- | + -- | + function Create (Fields : Field_Array_Access) return Form + is + function NewForm (Fields : System.Address) return Form; + pragma Import (C, NewForm, "new_form"); + + M : Form; + begin + pragma Assert (Fields (Fields'Last) = Null_Field); + if Fields (Fields'Last) /= Null_Field then + raise Form_Exception; + else + M := NewForm (Fields (Fields'First)'Address); + if M = Null_Form then + raise Form_Exception; + end if; + return M; + end if; + end Create; + -- | + -- | + -- | + procedure Delete (Frm : in out Form) + is + function Free (Frm : Form) return C_Int; + pragma Import (C, Free, "free_form"); + + Res : constant Eti_Error := Free (Frm); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + Frm := Null_Form; + end Delete; + -- | + -- |===================================================================== + -- | man page form_opts.3x + -- |===================================================================== + -- | + -- | + -- | + procedure Set_Options (Frm : in Form; + Options : in Form_Option_Set) + is + function Set_Form_Opts (Frm : Form; + Opt : C_Int) return C_Int; + pragma Import (C, Set_Form_Opts, "set_form_opts"); + + Opt : C_Int := FrmOS_2_CInt (Options); + Res : Eti_Error; + begin + Res := Set_Form_Opts (Frm, Opt); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Options; + -- | + -- | + -- | + procedure Switch_Options (Frm : in Form; + Options : in Form_Option_Set; + On : Boolean := True) + is + function Form_Opts_On (Frm : Form; + Opt : C_Int) return C_Int; + pragma Import (C, Form_Opts_On, "form_opts_on"); + function Form_Opts_Off (Frm : Form; + Opt : C_Int) return C_Int; + pragma Import (C, Form_Opts_Off, "form_opts_off"); + + Err : Eti_Error; + Opt : C_Int := FrmOS_2_CInt (Options); + begin + if On then + Err := Form_Opts_On (Frm, Opt); + else + Err := Form_Opts_Off (Frm, Opt); + end if; + if Err /= E_Ok then + Eti_Exception (Err); + end if; + end Switch_Options; + -- | + -- | + -- | + procedure Get_Options (Frm : in Form; + Options : out Form_Option_Set) + is + function Form_Opts (Frm : Form) return C_Int; + pragma Import (C, Form_Opts, "form_opts"); + + Res : C_Int := Form_Opts (Frm); + begin + Options := CInt_2_FrmOS (Res); + end Get_Options; + -- | + -- | + -- | + function Get_Options (Frm : Form := Null_Form) return Form_Option_Set + is + Fos : Form_Option_Set; + begin + Get_Options (Frm, Fos); + return Fos; + end Get_Options; + -- | + -- |===================================================================== + -- | man page form_post.3x + -- |===================================================================== + -- | + -- | + -- | + procedure Post (Frm : in Form; + Post : in Boolean := True) + is + function M_Post (Frm : Form) return C_Int; + pragma Import (C, M_Post, "post_form"); + function M_Unpost (Frm : Form) return C_Int; + pragma Import (C, M_Unpost, "unpost_form"); + + Res : Eti_Error; + begin + if Post then + Res := M_Post (Frm); + else + Res := M_Unpost (Frm); + end if; + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Post; + -- | + -- |===================================================================== + -- | man page form_cursor.3x + -- |===================================================================== + -- | + -- | + -- | + procedure Position_Cursor (Frm : Form) + is + function Pos_Form_Cursor (Frm : Form) return C_Int; + pragma Import (C, Pos_Form_Cursor, "pos_form_cursor"); + + Res : constant Eti_Error := Pos_Form_Cursor (Frm); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Position_Cursor; + -- | + -- |===================================================================== + -- | man page form_data.3x + -- |===================================================================== + -- | + -- | + -- | + function Data_Ahead (Frm : Form) return Boolean + is + function Ahead (Frm : Form) return C_Int; + pragma Import (C, Ahead, "data_ahead"); + + Res : constant C_Int := Ahead (Frm); + begin + if Res = Curses_False then + return False; + else + return True; + end if; + end Data_Ahead; + -- | + -- | + -- | + function Data_Behind (Frm : Form) return Boolean + is + function Behind (Frm : Form) return C_Int; + pragma Import (C, Behind, "data_behind"); + + Res : constant C_Int := Behind (Frm); + begin + if Res = Curses_False then + return False; + else + return True; + end if; + end Data_Behind; + -- | + -- |===================================================================== + -- | man page form_driver.3x + -- |===================================================================== + -- | + -- | + -- | + function Driver (Frm : Form; + Key : Key_Code) return Driver_Result + is + function Frm_Driver (Frm : Form; Key : C_Int) return C_Int; + pragma Import (C, Frm_Driver, "form_driver"); + + R : Eti_Error := Frm_Driver (Frm, C_Int (Key)); + begin + if R /= E_Ok then + if R = E_Unknown_Command then + return Unknown_Request; + elsif R = E_Invalid_Field then + return Invalid_Field; + elsif R = E_Request_Denied then + return Request_Denied; + else + Eti_Exception (R); + return Form_Ok; + end if; + else + return Form_Ok; + end if; + end Driver; + -- | + -- |===================================================================== + -- | man page form_page.3x + -- |===================================================================== + -- | + -- | + -- | + procedure Set_Current (Frm : in Form; + Fld : in Field) + is + function Set_Current_Fld (Frm : Form; Fld : Field) return C_Int; + pragma Import (C, Set_Current_Fld, "set_current_field"); + + Res : constant Eti_Error := Set_Current_Fld (Frm, Fld); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Current; + -- | + -- | + -- | + function Current (Frm : in Form) return Field + is + function Current_Fld (Frm : Form) return Field; + pragma Import (C, Current_Fld, "current_field"); + + Fld : constant Field := Current_Fld (Frm); + begin + if Fld = Null_Field then + raise Form_Exception; + end if; + return Fld; + end Current; + -- | + -- | + -- | + procedure Set_Page (Frm : in Form; + Page : in Page_Number := Page_Number'First) + is + function Set_Frm_Page (Frm : Form; Pg : C_Int) return C_Int; + pragma Import (C, Set_Frm_Page, "set_form_page"); + + Res : constant Eti_Error := Set_Frm_Page (Frm, C_Int (Page)); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Page; + -- | + -- | + -- | + function Page (Frm : Form) return Page_Number + is + function Get_Page (Frm : Form) return C_Int; + pragma Import (C, Get_Page, "form_page"); + + P : constant C_Int := Get_Page (Frm); + begin + if P < 0 then + raise Form_Exception; + else + return Page_Number (P); + end if; + end Page; + + function Get_Index (Fld : Field) return Positive + is + function Get_Fieldindex (Fld : Field) return C_Int; + pragma Import (C, Get_Fieldindex, "field_index"); + + Res : constant C_Int := Get_Fieldindex (Fld); + begin + if Res = Curses_Err then + raise Form_Exception; + end if; + return Positive (Natural (Res) + Positive'First); + end Get_Index; + + -- | + -- |===================================================================== + -- | man page form_new_page.3x + -- |===================================================================== + -- | + -- | + -- | + procedure Set_New_Page (Fld : in Field; + New_Page : in Boolean := True) + is + function Set_Page (Fld : Field; Flg : C_Int) return C_Int; + pragma Import (C, Set_Page, "set_new_page"); + + Res : constant Eti_Error := Set_Page (Fld, Boolean'Pos (New_Page)); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_New_Page; + -- | + -- | + -- | + function Is_New_Page (Fld : Field) return Boolean + is + function Is_New (Fld : Field) return C_Int; + pragma Import (C, Is_New, "new_page"); + + Res : constant C_Int := Is_New (Fld); + begin + if Res = Curses_False then + return False; + else + return True; + end if; + end Is_New_Page; + + procedure Free (FA : in out Field_Array_Access; + Free_Fields : in Boolean := False) + is + procedure Release is new Ada.Unchecked_Deallocation + (Field_Array, Field_Array_Access); + begin + if FA /= null and then Free_Fields then + for I in FA'First .. (FA'Last - 1) loop + if (FA (I) /= Null_Field) then + Delete (FA (I)); + end if; + end loop; + end if; + Release (FA); + end Free; + + -- |===================================================================== + + function Default_Field_Options return Field_Option_Set + is + begin + return Get_Options (Null_Field); + end Default_Field_Options; + + function Default_Form_Options return Form_Option_Set + is + begin + return Get_Options (Null_Form); + end Default_Form_Options; + +end Terminal_Interface.Curses.Forms; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-menus-item_user_data.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-menus-item_user_data.adb new file mode 100644 index 0000000..3facadd --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-menus-item_user_data.adb @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Menus.Item_User_Data -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Interfaces.C; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +package body Terminal_Interface.Curses.Menus.Item_User_Data is + + use type Interfaces.C.int; + + procedure Set_User_Data (Itm : in Item; + Data : in User_Access) + is + function Set_Item_Userptr (Itm : Item; + Addr : User_Access) return C_Int; + pragma Import (C, Set_Item_Userptr, "set_item_userptr"); + + Res : constant Eti_Error := Set_Item_Userptr (Itm, Data); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_User_Data; + + function Get_User_Data (Itm : in Item) return User_Access + is + function Item_Userptr (Itm : Item) return User_Access; + pragma Import (C, Item_Userptr, "item_userptr"); + begin + return Item_Userptr (Itm); + end Get_User_Data; + + procedure Get_User_Data (Itm : in Item; + Data : out User_Access) + is + begin + Data := Get_User_Data (Itm); + end Get_User_Data; + +end Terminal_Interface.Curses.Menus.Item_User_Data; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb new file mode 100644 index 0000000..87ea22b --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb @@ -0,0 +1,76 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Menus.Menu_User_Data -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +package body Terminal_Interface.Curses.Menus.Menu_User_Data is + + use type Interfaces.C.int; + + procedure Set_User_Data (Men : in Menu; + Data : in User_Access) + is + function Set_Menu_Userptr (Men : Menu; + Data : User_Access) return C_Int; + pragma Import (C, Set_Menu_Userptr, "set_menu_userptr"); + + Res : constant Eti_Error := Set_Menu_Userptr (Men, Data); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_User_Data; + + function Get_User_Data (Men : in Menu) return User_Access + is + function Menu_Userptr (Men : Menu) return User_Access; + pragma Import (C, Menu_Userptr, "menu_userptr"); + begin + return Menu_Userptr (Men); + end Get_User_Data; + + procedure Get_User_Data (Men : in Menu; + Data : out User_Access) + is + begin + Data := Get_User_Data (Men); + end Get_User_Data; + +end Terminal_Interface.Curses.Menus.Menu_User_Data; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-menus.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-menus.adb new file mode 100644 index 0000000..3d70de3 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-menus.adb @@ -0,0 +1,1021 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Menus -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Ada.Unchecked_Deallocation; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +with Interfaces.C; use Interfaces.C; +with Interfaces.C.Strings; use Interfaces.C.Strings; +with Interfaces.C.Pointers; + +with Ada.Unchecked_Conversion; + +package body Terminal_Interface.Curses.Menus is + + type C_Item_Array is array (Natural range <>) of aliased Item; + package I_Array is new + Interfaces.C.Pointers (Natural, Item, C_Item_Array, Null_Item); + + use type System.Bit_Order; + subtype chars_ptr is Interfaces.C.Strings.chars_ptr; + + function MOS_2_CInt is new + Ada.Unchecked_Conversion (Menu_Option_Set, + C_Int); + + function CInt_2_MOS is new + Ada.Unchecked_Conversion (C_Int, + Menu_Option_Set); + + function IOS_2_CInt is new + Ada.Unchecked_Conversion (Item_Option_Set, + C_Int); + + function CInt_2_IOS is new + Ada.Unchecked_Conversion (C_Int, + Item_Option_Set); + +------------------------------------------------------------------------------ + procedure Request_Name (Key : in Menu_Request_Code; + Name : out String) + is + function Request_Name (Key : C_Int) return chars_ptr; + pragma Import (C, Request_Name, "menu_request_name"); + begin + Fill_String (Request_Name (C_Int (Key)), Name); + end Request_Name; + + function Request_Name (Key : Menu_Request_Code) return String + is + function Request_Name (Key : C_Int) return chars_ptr; + pragma Import (C, Request_Name, "menu_request_name"); + begin + return Fill_String (Request_Name (C_Int (Key))); + end Request_Name; + + function Create (Name : String; + Description : String := "") return Item + is + type Char_Ptr is access all Interfaces.C.char; + function Newitem (Name, Desc : Char_Ptr) return Item; + pragma Import (C, Newitem, "new_item"); + + type Name_String is new char_array (0 .. Name'Length); + type Name_String_Ptr is access Name_String; + pragma Controlled (Name_String_Ptr); + + type Desc_String is new char_array (0 .. Description'Length); + type Desc_String_Ptr is access Desc_String; + pragma Controlled (Desc_String_Ptr); + + Name_Str : Name_String_Ptr := new Name_String; + Desc_Str : Desc_String_Ptr := new Desc_String; + Name_Len, Desc_Len : size_t; + Result : Item; + begin + To_C (Name, Name_Str.all, Name_Len); + To_C (Description, Desc_Str.all, Desc_Len); + Result := Newitem (Name_Str.all (Name_Str.all'First)'Access, + Desc_Str.all (Desc_Str.all'First)'Access); + if Result = Null_Item then + raise Eti_System_Error; + end if; + return Result; + end Create; + + procedure Delete (Itm : in out Item) + is + function Descname (Itm : Item) return chars_ptr; + pragma Import (C, Descname, "item_description"); + function Itemname (Itm : Item) return chars_ptr; + pragma Import (C, Itemname, "item_name"); + + function Freeitem (Itm : Item) return C_Int; + pragma Import (C, Freeitem, "free_item"); + + Res : Eti_Error; + Ptr : chars_ptr; + begin + Ptr := Descname (Itm); + if Ptr /= Null_Ptr then + Interfaces.C.Strings.Free (Ptr); + end if; + Ptr := Itemname (Itm); + if Ptr /= Null_Ptr then + Interfaces.C.Strings.Free (Ptr); + end if; + Res := Freeitem (Itm); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + Itm := Null_Item; + end Delete; +------------------------------------------------------------------------------- + procedure Set_Value (Itm : in Item; + Value : in Boolean := True) + is + function Set_Item_Val (Itm : Item; + Val : C_Int) return C_Int; + pragma Import (C, Set_Item_Val, "set_item_value"); + + Res : constant Eti_Error := Set_Item_Val (Itm, Boolean'Pos (Value)); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Value; + + function Value (Itm : Item) return Boolean + is + function Item_Val (Itm : Item) return C_Int; + pragma Import (C, Item_Val, "item_value"); + begin + if Item_Val (Itm) = Curses_False then + return False; + else + return True; + end if; + end Value; + +------------------------------------------------------------------------------- + function Visible (Itm : Item) return Boolean + is + function Item_Vis (Itm : Item) return C_Int; + pragma Import (C, Item_Vis, "item_visible"); + begin + if Item_Vis (Itm) = Curses_False then + return False; + else + return True; + end if; + end Visible; +------------------------------------------------------------------------------- + procedure Set_Options (Itm : in Item; + Options : in Item_Option_Set) + is + function Set_Item_Opts (Itm : Item; + Opt : C_Int) return C_Int; + pragma Import (C, Set_Item_Opts, "set_item_opts"); + + Opt : C_Int := IOS_2_CInt (Options); + Res : Eti_Error; + begin + Res := Set_Item_Opts (Itm, Opt); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Options; + + procedure Switch_Options (Itm : in Item; + Options : in Item_Option_Set; + On : Boolean := True) + is + function Item_Opts_On (Itm : Item; + Opt : C_Int) return C_Int; + pragma Import (C, Item_Opts_On, "item_opts_on"); + function Item_Opts_Off (Itm : Item; + Opt : C_Int) return C_Int; + pragma Import (C, Item_Opts_Off, "item_opts_off"); + + Opt : C_Int := IOS_2_CInt (Options); + Err : Eti_Error; + begin + if On then + Err := Item_Opts_On (Itm, Opt); + else + Err := Item_Opts_Off (Itm, Opt); + end if; + if Err /= E_Ok then + Eti_Exception (Err); + end if; + end Switch_Options; + + procedure Get_Options (Itm : in Item; + Options : out Item_Option_Set) + is + function Item_Opts (Itm : Item) return C_Int; + pragma Import (C, Item_Opts, "item_opts"); + + Res : C_Int := Item_Opts (Itm); + begin + Options := CInt_2_IOS (Res); + end Get_Options; + + function Get_Options (Itm : Item := Null_Item) return Item_Option_Set + is + Ios : Item_Option_Set; + begin + Get_Options (Itm, Ios); + return Ios; + end Get_Options; +------------------------------------------------------------------------------- + procedure Name (Itm : in Item; + Name : out String) + is + function Itemname (Itm : Item) return chars_ptr; + pragma Import (C, Itemname, "item_name"); + begin + Fill_String (Itemname (Itm), Name); + end Name; + + function Name (Itm : in Item) return String + is + function Itemname (Itm : Item) return chars_ptr; + pragma Import (C, Itemname, "item_name"); + begin + return Fill_String (Itemname (Itm)); + end Name; + + procedure Description (Itm : in Item; + Description : out String) + is + function Descname (Itm : Item) return chars_ptr; + pragma Import (C, Descname, "item_description"); + begin + Fill_String (Descname (Itm), Description); + end Description; + + function Description (Itm : in Item) return String + is + function Descname (Itm : Item) return chars_ptr; + pragma Import (C, Descname, "item_description"); + begin + return Fill_String (Descname (Itm)); + end Description; +------------------------------------------------------------------------------- + procedure Set_Current (Men : in Menu; + Itm : in Item) + is + function Set_Curr_Item (Men : Menu; + Itm : Item) return C_Int; + pragma Import (C, Set_Curr_Item, "set_current_item"); + + Res : constant Eti_Error := Set_Curr_Item (Men, Itm); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Current; + + function Current (Men : Menu) return Item + is + function Curr_Item (Men : Menu) return Item; + pragma Import (C, Curr_Item, "current_item"); + + Res : constant Item := Curr_Item (Men); + begin + if Res = Null_Item then + raise Menu_Exception; + end if; + return Res; + end Current; + + procedure Set_Top_Row (Men : in Menu; + Line : in Line_Position) + is + function Set_Toprow (Men : Menu; + Line : C_Int) return C_Int; + pragma Import (C, Set_Toprow, "set_top_row"); + + Res : constant Eti_Error := Set_Toprow (Men, C_Int (Line)); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Top_Row; + + function Top_Row (Men : Menu) return Line_Position + is + function Toprow (Men : Menu) return C_Int; + pragma Import (C, Toprow, "top_row"); + + Res : constant C_Int := Toprow (Men); + begin + if Res = Curses_Err then + raise Menu_Exception; + end if; + return Line_Position (Res); + end Top_Row; + + function Get_Index (Itm : Item) return Positive + is + function Get_Itemindex (Itm : Item) return C_Int; + pragma Import (C, Get_Itemindex, "item_index"); + + Res : constant C_Int := Get_Itemindex (Itm); + begin + if Res = Curses_Err then + raise Menu_Exception; + end if; + return Positive (Natural (Res) + Positive'First); + end Get_Index; +------------------------------------------------------------------------------- + procedure Post (Men : in Menu; + Post : in Boolean := True) + is + function M_Post (Men : Menu) return C_Int; + pragma Import (C, M_Post, "post_menu"); + function M_Unpost (Men : Menu) return C_Int; + pragma Import (C, M_Unpost, "unpost_menu"); + + Res : Eti_Error; + begin + if Post then + Res := M_Post (Men); + else + Res := M_Unpost (Men); + end if; + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Post; +------------------------------------------------------------------------------- + procedure Set_Options (Men : in Menu; + Options : in Menu_Option_Set) + is + function Set_Menu_Opts (Men : Menu; + Opt : C_Int) return C_Int; + pragma Import (C, Set_Menu_Opts, "set_menu_opts"); + + Opt : C_Int := MOS_2_CInt (Options); + Res : Eti_Error; + begin + Res := Set_Menu_Opts (Men, Opt); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Options; + + procedure Switch_Options (Men : in Menu; + Options : in Menu_Option_Set; + On : in Boolean := True) + is + function Menu_Opts_On (Men : Menu; + Opt : C_Int) return C_Int; + pragma Import (C, Menu_Opts_On, "menu_opts_on"); + function Menu_Opts_Off (Men : Menu; + Opt : C_Int) return C_Int; + pragma Import (C, Menu_Opts_Off, "menu_opts_off"); + + Opt : C_Int := MOS_2_CInt (Options); + Err : Eti_Error; + begin + if On then + Err := Menu_Opts_On (Men, Opt); + else + Err := Menu_Opts_Off (Men, Opt); + end if; + if Err /= E_Ok then + Eti_Exception (Err); + end if; + end Switch_Options; + + procedure Get_Options (Men : in Menu; + Options : out Menu_Option_Set) + is + function Menu_Opts (Men : Menu) return C_Int; + pragma Import (C, Menu_Opts, "menu_opts"); + + Res : C_Int := Menu_Opts (Men); + begin + Options := CInt_2_MOS (Res); + end Get_Options; + + function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set + is + Mos : Menu_Option_Set; + begin + Get_Options (Men, Mos); + return Mos; + end Get_Options; +------------------------------------------------------------------------------- + procedure Set_Window (Men : in Menu; + Win : in Window) + is + function Set_Menu_Win (Men : Menu; + Win : Window) return C_Int; + pragma Import (C, Set_Menu_Win, "set_menu_win"); + + Res : constant Eti_Error := Set_Menu_Win (Men, Win); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Window; + + function Get_Window (Men : Menu) return Window + is + function Menu_Win (Men : Menu) return Window; + pragma Import (C, Menu_Win, "menu_win"); + + W : constant Window := Menu_Win (Men); + begin + return W; + end Get_Window; + + procedure Set_Sub_Window (Men : in Menu; + Win : in Window) + is + function Set_Menu_Sub (Men : Menu; + Win : Window) return C_Int; + pragma Import (C, Set_Menu_Sub, "set_menu_sub"); + + Res : constant Eti_Error := Set_Menu_Sub (Men, Win); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Sub_Window; + + function Get_Sub_Window (Men : Menu) return Window + is + function Menu_Sub (Men : Menu) return Window; + pragma Import (C, Menu_Sub, "menu_sub"); + + W : constant Window := Menu_Sub (Men); + begin + return W; + end Get_Sub_Window; + + procedure Scale (Men : in Menu; + Lines : out Line_Count; + Columns : out Column_Count) + is + type C_Int_Access is access all C_Int; + function M_Scale (Men : Menu; + Yp, Xp : C_Int_Access) return C_Int; + pragma Import (C, M_Scale, "scale_menu"); + + X, Y : aliased C_Int; + Res : constant Eti_Error := M_Scale (Men, Y'Access, X'Access); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + Lines := Line_Count (Y); + Columns := Column_Count (X); + end Scale; +------------------------------------------------------------------------------- + procedure Position_Cursor (Men : Menu) + is + function Pos_Menu_Cursor (Men : Menu) return C_Int; + pragma Import (C, Pos_Menu_Cursor, "pos_menu_cursor"); + + Res : constant Eti_Error := Pos_Menu_Cursor (Men); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Position_Cursor; + +------------------------------------------------------------------------------- + procedure Set_Mark (Men : in Menu; + Mark : in String) + is + type Char_Ptr is access all Interfaces.C.char; + function Set_Mark (Men : Menu; + Mark : Char_Ptr) return C_Int; + pragma Import (C, Set_Mark, "set_menu_mark"); + + Txt : char_array (0 .. Mark'Length); + Len : size_t; + Res : Eti_Error; + begin + To_C (Mark, Txt, Len); + Res := Set_Mark (Men, Txt (Txt'First)'Access); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Mark; + + procedure Mark (Men : in Menu; + Mark : out String) + is + function Get_Menu_Mark (Men : Menu) return chars_ptr; + pragma Import (C, Get_Menu_Mark, "menu_mark"); + begin + Fill_String (Get_Menu_Mark (Men), Mark); + end Mark; + + function Mark (Men : Menu) return String + is + function Get_Menu_Mark (Men : Menu) return chars_ptr; + pragma Import (C, Get_Menu_Mark, "menu_mark"); + begin + return Fill_String (Get_Menu_Mark (Men)); + end Mark; + +------------------------------------------------------------------------------- + procedure Set_Foreground + (Men : in Menu; + Fore : in Character_Attribute_Set := Normal_Video; + Color : in Color_Pair := Color_Pair'First) + is + function Set_Menu_Fore (Men : Menu; + Attr : C_Chtype) return C_Int; + pragma Import (C, Set_Menu_Fore, "set_menu_fore"); + + Ch : constant Attributed_Character := (Ch => Character'First, + Color => Color, + Attr => Fore); + Res : constant Eti_Error := Set_Menu_Fore (Men, AttrChar_To_Chtype (Ch)); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Foreground; + + procedure Foreground (Men : in Menu; + Fore : out Character_Attribute_Set) + is + function Menu_Fore (Men : Menu) return C_Chtype; + pragma Import (C, Menu_Fore, "menu_fore"); + begin + Fore := Chtype_To_AttrChar (Menu_Fore (Men)).Attr; + end Foreground; + + procedure Foreground (Men : in Menu; + Fore : out Character_Attribute_Set; + Color : out Color_Pair) + is + function Menu_Fore (Men : Menu) return C_Chtype; + pragma Import (C, Menu_Fore, "menu_fore"); + begin + Fore := Chtype_To_AttrChar (Menu_Fore (Men)).Attr; + Color := Chtype_To_AttrChar (Menu_Fore (Men)).Color; + end Foreground; + + procedure Set_Background + (Men : in Menu; + Back : in Character_Attribute_Set := Normal_Video; + Color : in Color_Pair := Color_Pair'First) + is + function Set_Menu_Back (Men : Menu; + Attr : C_Chtype) return C_Int; + pragma Import (C, Set_Menu_Back, "set_menu_back"); + + Ch : constant Attributed_Character := (Ch => Character'First, + Color => Color, + Attr => Back); + Res : constant Eti_Error := Set_Menu_Back (Men, AttrChar_To_Chtype (Ch)); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Background; + + procedure Background (Men : in Menu; + Back : out Character_Attribute_Set) + is + function Menu_Back (Men : Menu) return C_Chtype; + pragma Import (C, Menu_Back, "menu_back"); + begin + Back := Chtype_To_AttrChar (Menu_Back (Men)).Attr; + end Background; + + procedure Background (Men : in Menu; + Back : out Character_Attribute_Set; + Color : out Color_Pair) + is + function Menu_Back (Men : Menu) return C_Chtype; + pragma Import (C, Menu_Back, "menu_back"); + begin + Back := Chtype_To_AttrChar (Menu_Back (Men)).Attr; + Color := Chtype_To_AttrChar (Menu_Back (Men)).Color; + end Background; + + procedure Set_Grey (Men : in Menu; + Grey : in Character_Attribute_Set := Normal_Video; + Color : in Color_Pair := Color_Pair'First) + is + function Set_Menu_Grey (Men : Menu; + Attr : C_Chtype) return C_Int; + pragma Import (C, Set_Menu_Grey, "set_menu_grey"); + + Ch : constant Attributed_Character := (Ch => Character'First, + Color => Color, + Attr => Grey); + + Res : constant Eti_Error := Set_Menu_Grey (Men, AttrChar_To_Chtype (Ch)); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Grey; + + procedure Grey (Men : in Menu; + Grey : out Character_Attribute_Set) + is + function Menu_Grey (Men : Menu) return C_Chtype; + pragma Import (C, Menu_Grey, "menu_grey"); + begin + Grey := Chtype_To_AttrChar (Menu_Grey (Men)).Attr; + end Grey; + + procedure Grey (Men : in Menu; + Grey : out Character_Attribute_Set; + Color : out Color_Pair) + is + function Menu_Grey (Men : Menu) return C_Chtype; + pragma Import (C, Menu_Grey, "menu_grey"); + begin + Grey := Chtype_To_AttrChar (Menu_Grey (Men)).Attr; + Color := Chtype_To_AttrChar (Menu_Grey (Men)).Color; + end Grey; + + procedure Set_Pad_Character (Men : in Menu; + Pad : in Character := Space) + is + function Set_Menu_Pad (Men : Menu; + Ch : C_Int) return C_Int; + pragma Import (C, Set_Menu_Pad, "set_menu_pad"); + + Res : constant Eti_Error := Set_Menu_Pad (Men, + C_Int (Character'Pos (Pad))); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Pad_Character; + + procedure Pad_Character (Men : in Menu; + Pad : out Character) + is + function Menu_Pad (Men : Menu) return C_Int; + pragma Import (C, Menu_Pad, "menu_pad"); + begin + Pad := Character'Val (Menu_Pad (Men)); + end Pad_Character; +------------------------------------------------------------------------------- + procedure Set_Spacing (Men : in Menu; + Descr : in Column_Position := 0; + Row : in Line_Position := 0; + Col : in Column_Position := 0) + is + function Set_Spacing (Men : Menu; + D, R, C : C_Int) return C_Int; + pragma Import (C, Set_Spacing, "set_menu_spacing"); + + Res : constant Eti_Error := Set_Spacing (Men, + C_Int (Descr), + C_Int (Row), + C_Int (Col)); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Spacing; + + procedure Spacing (Men : in Menu; + Descr : out Column_Position; + Row : out Line_Position; + Col : out Column_Position) + is + type C_Int_Access is access all C_Int; + function Get_Spacing (Men : Menu; + D, R, C : C_Int_Access) return C_Int; + pragma Import (C, Get_Spacing, "menu_spacing"); + + D, R, C : aliased C_Int; + Res : constant Eti_Error := Get_Spacing (Men, + D'Access, + R'Access, + C'Access); + begin + if Res /= E_Ok then + Eti_Exception (Res); + else + Descr := Column_Position (D); + Row := Line_Position (R); + Col := Column_Position (C); + end if; + end Spacing; +------------------------------------------------------------------------------- + function Set_Pattern (Men : Menu; + Text : String) return Boolean + is + type Char_Ptr is access all Interfaces.C.char; + function Set_Pattern (Men : Menu; + Pattern : Char_Ptr) return C_Int; + pragma Import (C, Set_Pattern, "set_menu_pattern"); + + S : char_array (0 .. Text'Length); + L : size_t; + Res : Eti_Error; + begin + To_C (Text, S, L); + Res := Set_Pattern (Men, S (S'First)'Access); + case Res is + when E_No_Match => return False; + when E_Ok => return True; + when others => + Eti_Exception (Res); + return False; + end case; + end Set_Pattern; + + procedure Pattern (Men : in Menu; + Text : out String) + is + function Get_Pattern (Men : Menu) return chars_ptr; + pragma Import (C, Get_Pattern, "menu_pattern"); + begin + Fill_String (Get_Pattern (Men), Text); + end Pattern; +------------------------------------------------------------------------------- + procedure Set_Format (Men : in Menu; + Lines : in Line_Count; + Columns : in Column_Count) + is + function Set_Menu_Fmt (Men : Menu; + Lin : C_Int; + Col : C_Int) return C_Int; + pragma Import (C, Set_Menu_Fmt, "set_menu_format"); + + Res : constant Eti_Error := Set_Menu_Fmt (Men, + C_Int (Lines), + C_Int (Columns)); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Format; + + procedure Format (Men : in Menu; + Lines : out Line_Count; + Columns : out Column_Count) + is + type C_Int_Access is access all C_Int; + function Menu_Fmt (Men : Menu; + Y, X : C_Int_Access) return C_Int; + pragma Import (C, Menu_Fmt, "menu_format"); + + L, C : aliased C_Int; + Res : constant Eti_Error := Menu_Fmt (Men, L'Access, C'Access); + begin + if Res /= E_Ok then + Eti_Exception (Res); + else + Lines := Line_Count (L); + Columns := Column_Count (C); + end if; + end Format; +------------------------------------------------------------------------------- + procedure Set_Item_Init_Hook (Men : in Menu; + Proc : in Menu_Hook_Function) + is + function Set_Item_Init (Men : Menu; + Proc : Menu_Hook_Function) return C_Int; + pragma Import (C, Set_Item_Init, "set_item_init"); + + Res : constant Eti_Error := Set_Item_Init (Men, Proc); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Item_Init_Hook; + + procedure Set_Item_Term_Hook (Men : in Menu; + Proc : in Menu_Hook_Function) + is + function Set_Item_Term (Men : Menu; + Proc : Menu_Hook_Function) return C_Int; + pragma Import (C, Set_Item_Term, "set_item_term"); + + Res : constant Eti_Error := Set_Item_Term (Men, Proc); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Item_Term_Hook; + + procedure Set_Menu_Init_Hook (Men : in Menu; + Proc : in Menu_Hook_Function) + is + function Set_Menu_Init (Men : Menu; + Proc : Menu_Hook_Function) return C_Int; + pragma Import (C, Set_Menu_Init, "set_menu_init"); + + Res : constant Eti_Error := Set_Menu_Init (Men, Proc); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Menu_Init_Hook; + + procedure Set_Menu_Term_Hook (Men : in Menu; + Proc : in Menu_Hook_Function) + is + function Set_Menu_Term (Men : Menu; + Proc : Menu_Hook_Function) return C_Int; + pragma Import (C, Set_Menu_Term, "set_menu_term"); + + Res : constant Eti_Error := Set_Menu_Term (Men, Proc); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end Set_Menu_Term_Hook; + + function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function + is + function Item_Init (Men : Menu) return Menu_Hook_Function; + pragma Import (C, Item_Init, "item_init"); + begin + return Item_Init (Men); + end Get_Item_Init_Hook; + + function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function + is + function Item_Term (Men : Menu) return Menu_Hook_Function; + pragma Import (C, Item_Term, "item_term"); + begin + return Item_Term (Men); + end Get_Item_Term_Hook; + + function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function + is + function Menu_Init (Men : Menu) return Menu_Hook_Function; + pragma Import (C, Menu_Init, "menu_init"); + begin + return Menu_Init (Men); + end Get_Menu_Init_Hook; + + function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function + is + function Menu_Term (Men : Menu) return Menu_Hook_Function; + pragma Import (C, Menu_Term, "menu_term"); + begin + return Menu_Term (Men); + end Get_Menu_Term_Hook; +------------------------------------------------------------------------------- + procedure Redefine (Men : in Menu; + Items : in Item_Array_Access) + is + function Set_Items (Men : Menu; + Items : System.Address) return C_Int; + pragma Import (C, Set_Items, "set_menu_items"); + + Res : Eti_Error; + begin + pragma Assert (Items (Items'Last) = Null_Item); + if Items (Items'Last) /= Null_Item then + raise Menu_Exception; + else + Res := Set_Items (Men, Items.all'Address); + if Res /= E_Ok then + Eti_Exception (Res); + end if; + end if; + end Redefine; + + function Item_Count (Men : Menu) return Natural + is + function Count (Men : Menu) return C_Int; + pragma Import (C, Count, "item_count"); + begin + return Natural (Count (Men)); + end Item_Count; + + function Items (Men : Menu; + Index : Positive) return Item + is + use I_Array; + + function C_Mitems (Men : Menu) return Pointer; + pragma Import (C, C_Mitems, "menu_items"); + + P : Pointer := C_Mitems (Men); + begin + if P = null or else Index not in 1 .. Item_Count (Men) then + raise Menu_Exception; + else + P := P + ptrdiff_t (C_Int (Index) - 1); + return P.all; + end if; + end Items; + +------------------------------------------------------------------------------- + function Create (Items : Item_Array_Access) return Menu + is + function Newmenu (Items : System.Address) return Menu; + pragma Import (C, Newmenu, "new_menu"); + + M : Menu; + begin + pragma Assert (Items (Items'Last) = Null_Item); + if Items (Items'Last) /= Null_Item then + raise Menu_Exception; + else + M := Newmenu (Items.all'Address); + if M = Null_Menu then + raise Menu_Exception; + end if; + return M; + end if; + end Create; + + procedure Delete (Men : in out Menu) + is + function Free (Men : Menu) return C_Int; + pragma Import (C, Free, "free_menu"); + + Res : constant Eti_Error := Free (Men); + begin + if Res /= E_Ok then + Eti_Exception (Res); + end if; + Men := Null_Menu; + end Delete; + +------------------------------------------------------------------------------ + function Driver (Men : Menu; + Key : Key_Code) return Driver_Result + is + function Driver (Men : Menu; + Key : C_Int) return C_Int; + pragma Import (C, Driver, "menu_driver"); + + R : Eti_Error := Driver (Men, C_Int (Key)); + begin + if R /= E_Ok then + case R is + when E_Unknown_Command => return Unknown_Request; + when E_No_Match => return No_Match; + when E_Request_Denied | + E_Not_Selectable => return Request_Denied; + when others => + Eti_Exception (R); + end case; + end if; + return Menu_Ok; + end Driver; + + procedure Free (IA : in out Item_Array_Access; + Free_Items : in Boolean := False) + is + procedure Release is new Ada.Unchecked_Deallocation + (Item_Array, Item_Array_Access); + begin + if IA /= null and then Free_Items then + for I in IA'First .. (IA'Last - 1) loop + if (IA (I) /= Null_Item) then + Delete (IA (I)); + end if; + end loop; + end if; + Release (IA); + end Free; + +------------------------------------------------------------------------------- + function Default_Menu_Options return Menu_Option_Set + is + begin + return Get_Options (Null_Menu); + end Default_Menu_Options; + + function Default_Item_Options return Item_Option_Set + is + begin + return Get_Options (Null_Item); + end Default_Item_Options; +------------------------------------------------------------------------------- + +end Terminal_Interface.Curses.Menus; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-mouse.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-mouse.adb new file mode 100644 index 0000000..0cf3c55 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-mouse.adb @@ -0,0 +1,214 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Mouse -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with System; + +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Interfaces.C; use Interfaces.C; +use Interfaces; + +package body Terminal_Interface.Curses.Mouse is + + use type System.Bit_Order; + use type Interfaces.C.int; + + function Has_Mouse return Boolean + is + function Mouse_Avail return C_Int; + pragma Import (C, Mouse_Avail, "_nc_has_mouse"); + begin + if Has_Key (Key_Mouse) or else Mouse_Avail /= 0 then + return True; + else + return False; + end if; + end Has_Mouse; + + function Get_Mouse return Mouse_Event + is + type Event_Access is access all Mouse_Event; + + function Getmouse (Ev : Event_Access) return C_Int; + pragma Import (C, Getmouse, "getmouse"); + + Event : aliased Mouse_Event; + begin + if Getmouse (Event'Access) = Curses_Err then + raise Curses_Exception; + end if; + return Event; + end Get_Mouse; + + procedure Register_Reportable_Event (Button : in Mouse_Button; + State : in Button_State; + Mask : in out Event_Mask) + is + Button_Nr : constant Natural := Mouse_Button'Pos (Button); + State_Nr : constant Natural := Button_State'Pos (State); + begin + if Button in Modifier_Keys and then State /= Pressed then + raise Curses_Exception; + else + if Button in Real_Buttons then + Mask := Mask or ((2 ** (6 * Button_Nr)) ** State_Nr); + else + Mask := Mask or (BUTTON_CTRL ** (Button_Nr - 4)); + end if; + end if; + end Register_Reportable_Event; + + procedure Register_Reportable_Events (Button : in Mouse_Button; + State : in Button_States; + Mask : in out Event_Mask) + is + begin + for S in Button_States'Range loop + if State (S) then + Register_Reportable_Event (Button, S, Mask); + end if; + end loop; + end Register_Reportable_Events; + + function Start_Mouse (Mask : Event_Mask := All_Events) + return Event_Mask + is + function MMask (M : Event_Mask; + O : access Event_Mask) return Event_Mask; + pragma Import (C, MMask, "mousemask"); + R : Event_Mask; + Old : aliased Event_Mask; + begin + R := MMask (Mask, Old'Access); + return Old; + end Start_Mouse; + + procedure End_Mouse (Mask : in Event_Mask := No_Events) + is + begin + null; + end End_Mouse; + + procedure Dispatch_Event (Mask : in Event_Mask; + Button : out Mouse_Button; + State : out Button_State); + + procedure Dispatch_Event (Mask : in Event_Mask; + Button : out Mouse_Button; + State : out Button_State) is + L : Event_Mask; + begin + Button := Alt; -- preset to non real button; + if (Mask and BUTTON1_EVENTS) /= 0 then + Button := Left; + elsif (Mask and BUTTON2_EVENTS) /= 0 then + Button := Middle; + elsif (Mask and BUTTON3_EVENTS) /= 0 then + Button := Right; + elsif (Mask and BUTTON4_EVENTS) /= 0 then + Button := Button4; + end if; + if Button in Real_Buttons then + L := 2 ** (6 * Mouse_Button'Pos (Button)); + for I in Button_State'Range loop + if (Mask and L) /= 0 then + State := I; + exit; + end if; + L := 2 * L; + end loop; + else + State := Pressed; + if (Mask and BUTTON_CTRL) /= 0 then + Button := Control; + elsif (Mask and BUTTON_SHIFT) /= 0 then + Button := Shift; + elsif (Mask and BUTTON_ALT) /= 0 then + Button := Alt; + end if; + end if; + end Dispatch_Event; + + procedure Get_Event (Event : in Mouse_Event; + Y : out Line_Position; + X : out Column_Position; + Button : out Mouse_Button; + State : out Button_State) + is + Mask : constant Event_Mask := Event.Bstate; + begin + X := Column_Position (Event.X); + Y := Line_Position (Event.Y); + Dispatch_Event (Mask, Button, State); + end Get_Event; + + procedure Unget_Mouse (Event : in Mouse_Event) + is + function Ungetmouse (Ev : Mouse_Event) return C_Int; + pragma Import (C, Ungetmouse, "ungetmouse"); + begin + if Ungetmouse (Event) = Curses_Err then + raise Curses_Exception; + end if; + end Unget_Mouse; + + function Enclosed_In_Window (Win : Window := Standard_Window; + Event : Mouse_Event) return Boolean + is + function Wenclose (Win : Window; Y : C_Int; X : C_Int) + return Curses_Bool; + pragma Import (C, Wenclose, "wenclose"); + begin + if Wenclose (Win, C_Int (Event.Y), C_Int (Event.X)) + = Curses_Bool_False then + return False; + else + return True; + end if; + end Enclosed_In_Window; + + function Mouse_Interval (Msec : Natural := 200) return Natural + is + function Mouseinterval (Msec : C_Int) return C_Int; + pragma Import (C, Mouseinterval, "mouseinterval"); + begin + return Natural (Mouseinterval (C_Int (Msec))); + end Mouse_Interval; + +end Terminal_Interface.Curses.Mouse; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-panels-user_data.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-panels-user_data.adb new file mode 100644 index 0000000..1e18a0d --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-panels-user_data.adb @@ -0,0 +1,78 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Panels.User_Data -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Interfaces.C; +with Terminal_Interface.Curses.Aux; +use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Panels; +use Terminal_Interface.Curses.Panels; + +package body Terminal_Interface.Curses.Panels.User_Data is + + use type Interfaces.C.int; + + procedure Set_User_Data (Pan : in Panel; + Data : in User_Access) + is + function Set_Panel_Userptr (Pan : Panel; + Addr : User_Access) return C_Int; + pragma Import (C, Set_Panel_Userptr, "set_panel_userptr"); + begin + if Set_Panel_Userptr (Pan, Data) = Curses_Err then + raise Panel_Exception; + end if; + end Set_User_Data; + + function Get_User_Data (Pan : in Panel) return User_Access + is + function Panel_Userptr (Pan : Panel) return User_Access; + pragma Import (C, Panel_Userptr, "panel_userptr"); + begin + return Panel_Userptr (Pan); + end Get_User_Data; + + procedure Get_User_Data (Pan : in Panel; + Data : out User_Access) + is + begin + Data := Get_User_Data (Pan); + end Get_User_Data; + +end Terminal_Interface.Curses.Panels.User_Data; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-panels.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-panels.adb new file mode 100644 index 0000000..ebbaf2a --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-panels.adb @@ -0,0 +1,164 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Panels -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Interfaces.C; + +package body Terminal_Interface.Curses.Panels is + + use type Interfaces.C.int; + + function Create (Win : Window) return Panel + is + function Newpanel (Win : Window) return Panel; + pragma Import (C, Newpanel, "new_panel"); + + Pan : Panel; + begin + Pan := Newpanel (Win); + if Pan = Null_Panel then + raise Panel_Exception; + end if; + return Pan; + end Create; + + procedure Bottom (Pan : in Panel) + is + function Bottompanel (Pan : Panel) return C_Int; + pragma Import (C, Bottompanel, "bottom_panel"); + begin + if Bottompanel (Pan) = Curses_Err then + raise Panel_Exception; + end if; + end Bottom; + + procedure Top (Pan : in Panel) + is + function Toppanel (Pan : Panel) return C_Int; + pragma Import (C, Toppanel, "top_panel"); + begin + if Toppanel (Pan) = Curses_Err then + raise Panel_Exception; + end if; + end Top; + + procedure Show (Pan : in Panel) + is + function Showpanel (Pan : Panel) return C_Int; + pragma Import (C, Showpanel, "show_panel"); + begin + if Showpanel (Pan) = Curses_Err then + raise Panel_Exception; + end if; + end Show; + + procedure Hide (Pan : in Panel) + is + function Hidepanel (Pan : Panel) return C_Int; + pragma Import (C, Hidepanel, "hide_panel"); + begin + if Hidepanel (Pan) = Curses_Err then + raise Panel_Exception; + end if; + end Hide; + + function Get_Window (Pan : Panel) return Window + is + function Panel_Win (Pan : Panel) return Window; + pragma Import (C, Panel_Win, "panel_window"); + + Win : Window := Panel_Win (Pan); + begin + if Win = Null_Window then + raise Panel_Exception; + end if; + return Win; + end Get_Window; + + procedure Replace (Pan : in Panel; + Win : in Window) + is + function Replace_Pan (Pan : Panel; + Win : Window) return C_Int; + pragma Import (C, Replace_Pan, "replace_panel"); + begin + if Replace_Pan (Pan, Win) = Curses_Err then + raise Panel_Exception; + end if; + end Replace; + + procedure Move (Pan : in Panel; + Line : in Line_Position; + Column : in Column_Position) + is + function Move (Pan : Panel; + Line : C_Int; + Column : C_Int) return C_Int; + pragma Import (C, Move, "move_panel"); + begin + if Move (Pan, C_Int (Line), C_Int (Column)) = Curses_Err then + raise Panel_Exception; + end if; + end Move; + + function Is_Hidden (Pan : Panel) return Boolean + is + function Panel_Hidden (Pan : Panel) return C_Int; + pragma Import (C, Panel_Hidden, "panel_hidden"); + begin + if Panel_Hidden (Pan) = Curses_False then + return False; + else + return True; + end if; + end Is_Hidden; + + procedure Delete (Pan : in out Panel) + is + function Del_Panel (Pan : Panel) return C_Int; + pragma Import (C, Del_Panel, "del_panel"); + begin + if Del_Panel (Pan) = Curses_Err then + raise Panel_Exception; + end if; + Pan := Null_Panel; + end Delete; + +end Terminal_Interface.Curses.Panels; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-aux.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-aux.adb new file mode 100644 index 0000000..20b7609 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-aux.adb @@ -0,0 +1,128 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Aux -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +package body Terminal_Interface.Curses.Text_IO.Aux is + + procedure Put_Buf + (Win : in Window; + Buf : in String; + Width : in Field; + Signal : in Boolean := True; + Ljust : in Boolean := False) + is + L : Field; + Len : Field; + W : Field := Width; + LC : Line_Count; + CC : Column_Count; + Y : Line_Position; + X : Column_Position; + + procedure Output (From, To : Field); + + procedure Output (From, To : Field) + is + begin + if Len > 0 then + if W = 0 then + W := Len; + end if; + if Len > W then + -- LRM A10.6 (7) says this + W := Len; + end if; + + pragma Assert (Len <= W); + Get_Size (Win, LC, CC); + if Column_Count (Len) > CC then + if Signal then + raise Layout_Error; + else + return; + end if; + else + if Len < W and then not Ljust then + declare + Filler : constant String (1 .. (W - Len)) + := (others => ' '); + begin + Put (Win, Filler); + end; + end if; + Get_Cursor_Position (Win, Y, X); + if (X + Column_Position (Len)) > CC then + New_Line (Win); + end if; + Put (Win, Buf (From .. To)); + if Len < W and then Ljust then + declare + Filler : constant String (1 .. (W - Len)) + := (others => ' '); + begin + Put (Win, Filler); + end; + end if; + end if; + end if; + end Output; + + begin + pragma Assert (Win /= Null_Window); + if Ljust then + L := 1; + for I in 1 .. Buf'Length loop + exit when Buf (L) = ' '; + L := L + 1; + end loop; + Len := L - 1; + Output (1, Len); + else -- input buffer is not left justified + L := Buf'Length; + for I in 1 .. Buf'Length loop + exit when Buf (L) = ' '; + L := L - 1; + end loop; + Len := Buf'Length - L; + Output (L + 1, Buf'Length); + end if; + end Put_Buf; + +end Terminal_Interface.Curses.Text_IO.Aux; + diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-aux.ads b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-aux.ads new file mode 100644 index 0000000..0148053 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-aux.ads @@ -0,0 +1,55 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Aux -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +private package Terminal_Interface.Curses.Text_IO.Aux is + -- pragma Preelaborate (Aux); + + -- This routine is called from the Text_IO output routines for numeric + -- and enumeration types. + -- + procedure Put_Buf + (Win : in Window; -- The output window + Buf : in String; -- The buffer containing the text + Width : in Field; -- The width of the output field + Signal : in Boolean := True; -- If true, we raise Layout_Error + Ljust : in Boolean := False); -- The Buf is left justified + +end Terminal_Interface.Curses.Text_IO.Aux; + diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-complex_io.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-complex_io.adb new file mode 100644 index 0000000..2ed8b56 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-complex_io.adb @@ -0,0 +1,73 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Complex_IO -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Terminal_Interface.Curses.Text_IO.Float_IO; + +package body Terminal_Interface.Curses.Text_IO.Complex_IO is + + package FIO is new + Terminal_Interface.Curses.Text_IO.Float_IO (Complex_Types.Real'Base); + + procedure Put + (Win : in Window; + Item : in Complex; + Fore : in Field := Default_Fore; + Aft : in Field := Default_Aft; + Exp : in Field := Default_Exp) + is + begin + Put (Win, '('); + FIO.Put (Win, Item.Re, Fore, Aft, Exp); + Put (Win, ','); + FIO.Put (Win, Item.Im, Fore, Aft, Exp); + Put (Win, ')'); + end Put; + + procedure Put + (Item : in Complex; + Fore : in Field := Default_Fore; + Aft : in Field := Default_Aft; + Exp : in Field := Default_Exp) + is + begin + Put (Get_Window, Item, Fore, Aft, Exp); + end Put; + +end Terminal_Interface.Curses.Text_IO.Complex_IO; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-complex_io.ads b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-complex_io.ads new file mode 100644 index 0000000..c83a005 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-complex_io.ads @@ -0,0 +1,70 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Complex_IO -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Ada.Numerics.Generic_Complex_Types; + +generic + with package Complex_Types is new Ada.Numerics.Generic_Complex_Types (<>); + +package Terminal_Interface.Curses.Text_IO.Complex_IO is + + use Complex_Types; + + Default_Fore : Field := 2; + Default_Aft : Field := Real'Digits - 1; + Default_Exp : Field := 3; + + procedure Put + (Win : in Window; + Item : in Complex; + Fore : in Field := Default_Fore; + Aft : in Field := Default_Aft; + Exp : in Field := Default_Exp); + + procedure Put + (Item : in Complex; + Fore : in Field := Default_Fore; + Aft : in Field := Default_Aft; + Exp : in Field := Default_Exp); + +private + pragma Inline (Put); + +end Terminal_Interface.Curses.Text_IO.Complex_IO; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-decimal_io.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-decimal_io.adb new file mode 100644 index 0000000..a9cbbce --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-decimal_io.adb @@ -0,0 +1,75 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Decimal_IO -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Ada.Text_IO; +with Terminal_Interface.Curses.Text_IO.Aux; + +package body Terminal_Interface.Curses.Text_IO.Decimal_IO is + + package Aux renames Terminal_Interface.Curses.Text_IO.Aux; + package DIO is new Ada.Text_IO.Decimal_IO (Num); + + procedure Put + (Win : in Window; + Item : in Num; + Fore : in Field := Default_Fore; + Aft : in Field := Default_Aft; + Exp : in Field := Default_Exp) + is + Buf : String (1 .. Field'Last); + Len : Field := Fore + 1 + Aft; + begin + if Exp > 0 then + Len := Len + 1 + Exp; + end if; + DIO.Put (Buf, Item, Aft, Exp); + Aux.Put_Buf (Win, Buf, Len, False); + end Put; + + procedure Put + (Item : in Num; + Fore : in Field := Default_Fore; + Aft : in Field := Default_Aft; + Exp : in Field := Default_Exp) is + begin + Put (Get_Window, Item, Fore, Aft, Exp); + end Put; + +end Terminal_Interface.Curses.Text_IO.Decimal_IO; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-decimal_io.ads b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-decimal_io.ads new file mode 100644 index 0000000..73d243e --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-decimal_io.ads @@ -0,0 +1,66 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Decimal_IO -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +generic + type Num is delta <> digits <>; + +package Terminal_Interface.Curses.Text_IO.Decimal_IO is + + Default_Fore : Field := Num'Fore; + Default_Aft : Field := Num'Aft; + Default_Exp : Field := 0; + + procedure Put + (Win : in Window; + Item : in Num; + Fore : in Field := Default_Fore; + Aft : in Field := Default_Aft; + Exp : in Field := Default_Exp); + + procedure Put + (Item : in Num; + Fore : in Field := Default_Fore; + Aft : in Field := Default_Aft; + Exp : in Field := Default_Exp); + +private + pragma Inline (Put); + +end Terminal_Interface.Curses.Text_IO.Decimal_IO; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb new file mode 100644 index 0000000..5bf1332 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb @@ -0,0 +1,80 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Enumeration_IO -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Ada.Text_IO; +with Ada.Characters.Handling; use Ada.Characters.Handling; +with Terminal_Interface.Curses.Text_IO.Aux; + +package body Terminal_Interface.Curses.Text_IO.Enumeration_IO is + + package Aux renames Terminal_Interface.Curses.Text_IO.Aux; + package EIO is new Ada.Text_IO.Enumeration_IO (Enum); + + procedure Put + (Win : in Window; + Item : in Enum; + Width : in Field := Default_Width; + Set : in Type_Set := Default_Setting) + is + Buf : String (1 .. Field'Last); + Tset : Ada.Text_IO.Type_Set; + begin + if Set /= Mixed_Case then + Tset := Ada.Text_IO.Type_Set'Val (Type_Set'Pos (Set)); + else + Tset := Ada.Text_IO.Lower_Case; + end if; + EIO.Put (Buf, Item, Tset); + if Set = Mixed_Case then + Buf (Buf'First) := To_Upper (Buf (Buf'First)); + end if; + Aux.Put_Buf (Win, Buf, Width, True, True); + end Put; + + procedure Put + (Item : in Enum; + Width : in Field := Default_Width; + Set : in Type_Set := Default_Setting) + is + begin + Put (Get_Window, Item, Width, Set); + end Put; + +end Terminal_Interface.Curses.Text_IO.Enumeration_IO; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads new file mode 100644 index 0000000..86f2173 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads @@ -0,0 +1,63 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Enumeration_IO -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +generic + type Enum is (<>); + +package Terminal_Interface.Curses.Text_IO.Enumeration_IO is + + Default_Width : Field := 0; + Default_Setting : Type_Set := Mixed_Case; + + procedure Put + (Win : in Window; + Item : in Enum; + Width : in Field := Default_Width; + Set : in Type_Set := Default_Setting); + + procedure Put + (Item : in Enum; + Width : in Field := Default_Width; + Set : in Type_Set := Default_Setting); + +private + pragma Inline (Put); + +end Terminal_Interface.Curses.Text_IO.Enumeration_IO; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-fixed_io.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-fixed_io.adb new file mode 100644 index 0000000..0bd26fa --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-fixed_io.adb @@ -0,0 +1,75 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Fixed_IO -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Ada.Text_IO; +with Terminal_Interface.Curses.Text_IO.Aux; + +package body Terminal_Interface.Curses.Text_IO.Fixed_IO is + + package Aux renames Terminal_Interface.Curses.Text_IO.Aux; + package FIXIO is new Ada.Text_IO.Fixed_IO (Num); + + procedure Put + (Win : in Window; + Item : in Num; + Fore : in Field := Default_Fore; + Aft : in Field := Default_Aft; + Exp : in Field := Default_Exp) + is + Buf : String (1 .. Field'Last); + Len : Field := Fore + 1 + Aft; + begin + if Exp > 0 then + Len := Len + 1 + Exp; + end if; + FIXIO.Put (Buf, Item, Aft, Exp); + Aux.Put_Buf (Win, Buf, Len, False); + end Put; + + procedure Put + (Item : in Num; + Fore : in Field := Default_Fore; + Aft : in Field := Default_Aft; + Exp : in Field := Default_Exp) is + begin + Put (Get_Window, Item, Fore, Aft, Exp); + end Put; + +end Terminal_Interface.Curses.Text_IO.Fixed_IO; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-fixed_io.ads b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-fixed_io.ads new file mode 100644 index 0000000..83c5a16 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-fixed_io.ads @@ -0,0 +1,66 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Fixed_IO -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +generic + type Num is delta <>; + +package Terminal_Interface.Curses.Text_IO.Fixed_IO is + + Default_Fore : Field := Num'Fore; + Default_Aft : Field := Num'Aft; + Default_Exp : Field := 0; + + procedure Put + (Win : in Window; + Item : in Num; + Fore : in Field := Default_Fore; + Aft : in Field := Default_Aft; + Exp : in Field := Default_Exp); + + procedure Put + (Item : in Num; + Fore : in Field := Default_Fore; + Aft : in Field := Default_Aft; + Exp : in Field := Default_Exp); + +private + pragma Inline (Put); + +end Terminal_Interface.Curses.Text_IO.Fixed_IO; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-float_io.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-float_io.adb new file mode 100644 index 0000000..9b24daa --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-float_io.adb @@ -0,0 +1,76 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Float_IO -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Ada.Text_IO; +with Terminal_Interface.Curses.Text_IO.Aux; + +package body Terminal_Interface.Curses.Text_IO.Float_IO is + + package Aux renames Terminal_Interface.Curses.Text_IO.Aux; + package FIO is new Ada.Text_IO.Float_IO (Num); + + procedure Put + (Win : in Window; + Item : in Num; + Fore : in Field := Default_Fore; + Aft : in Field := Default_Aft; + Exp : in Field := Default_Exp) + is + Buf : String (1 .. Field'Last); + Len : Field := Fore + 1 + Aft; + begin + if Exp > 0 then + Len := Len + 1 + Exp; + end if; + FIO.Put (Buf, Item, Aft, Exp); + Aux.Put_Buf (Win, Buf, Len, False); + end Put; + + procedure Put + (Item : in Num; + Fore : in Field := Default_Fore; + Aft : in Field := Default_Aft; + Exp : in Field := Default_Exp) + is + begin + Put (Get_Window, Item, Fore, Aft, Exp); + end Put; + +end Terminal_Interface.Curses.Text_IO.Float_IO; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-float_io.ads b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-float_io.ads new file mode 100644 index 0000000..01fa996 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-float_io.ads @@ -0,0 +1,66 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Float_IO -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +generic + type Num is digits <>; + +package Terminal_Interface.Curses.Text_IO.Float_IO is + + Default_Fore : Field := 2; + Default_Aft : Field := Num'Digits - 1; + Default_Exp : Field := 3; + + procedure Put + (Win : in Window; + Item : in Num; + Fore : in Field := Default_Fore; + Aft : in Field := Default_Aft; + Exp : in Field := Default_Exp); + + procedure Put + (Item : in Num; + Fore : in Field := Default_Fore; + Aft : in Field := Default_Aft; + Exp : in Field := Default_Exp); + +private + pragma Inline (Put); + +end Terminal_Interface.Curses.Text_IO.Float_IO; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-integer_io.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-integer_io.adb new file mode 100644 index 0000000..b7bd495 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-integer_io.adb @@ -0,0 +1,70 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Integer_IO -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Ada.Text_IO; +with Terminal_Interface.Curses.Text_IO.Aux; + +package body Terminal_Interface.Curses.Text_IO.Integer_IO is + + package Aux renames Terminal_Interface.Curses.Text_IO.Aux; + package IIO is new Ada.Text_IO.Integer_IO (Num); + + procedure Put + (Win : in Window; + Item : in Num; + Width : in Field := Default_Width; + Base : in Number_Base := Default_Base) + is + Buf : String (1 .. Field'Last); + begin + IIO.Put (Buf, Item, Base); + Aux.Put_Buf (Win, Buf, Width); + end Put; + + procedure Put + (Item : in Num; + Width : in Field := Default_Width; + Base : in Number_Base := Default_Base) + is + begin + Put (Get_Window, Item, Width, Base); + end Put; + +end Terminal_Interface.Curses.Text_IO.Integer_IO; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-integer_io.ads b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-integer_io.ads new file mode 100644 index 0000000..a4e430e --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-integer_io.ads @@ -0,0 +1,63 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Integer_IO -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +generic + type Num is range <>; + +package Terminal_Interface.Curses.Text_IO.Integer_IO is + + Default_Width : Field := Num'Width; + Default_Base : Number_Base := 10; + + procedure Put + (Win : in Window; + Item : in Num; + Width : in Field := Default_Width; + Base : in Number_Base := Default_Base); + + procedure Put + (Item : in Num; + Width : in Field := Default_Width; + Base : in Number_Base := Default_Base); + +private + pragma Inline (Put); + +end Terminal_Interface.Curses.Text_IO.Integer_IO; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-modular_io.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-modular_io.adb new file mode 100644 index 0000000..aff0666 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-modular_io.adb @@ -0,0 +1,70 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Modular_IO -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Ada.Text_IO; +with Terminal_Interface.Curses.Text_IO.Aux; + +package body Terminal_Interface.Curses.Text_IO.Modular_IO is + + package Aux renames Terminal_Interface.Curses.Text_IO.Aux; + package MIO is new Ada.Text_IO.Modular_IO (Num); + + procedure Put + (Win : in Window; + Item : in Num; + Width : in Field := Default_Width; + Base : in Number_Base := Default_Base) + is + Buf : String (1 .. Field'Last); + begin + MIO.Put (Buf, Item, Base); + Aux.Put_Buf (Win, Buf, Width); + end Put; + + procedure Put + (Item : in Num; + Width : in Field := Default_Width; + Base : in Number_Base := Default_Base) + is + begin + Put (Get_Window, Item, Width, Base); + end Put; + +end Terminal_Interface.Curses.Text_IO.Modular_IO; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-modular_io.ads b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-modular_io.ads new file mode 100644 index 0000000..9033f7f --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io-modular_io.ads @@ -0,0 +1,63 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Modular_IO -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +generic + type Num is mod <>; + +package Terminal_Interface.Curses.Text_IO.Modular_IO is + + Default_Width : Field := Num'Width; + Default_Base : Number_Base := 10; + + procedure Put + (Win : in Window; + Item : in Num; + Width : in Field := Default_Width; + Base : in Number_Base := Default_Base); + + procedure Put + (Item : in Num; + Width : in Field := Default_Width; + Base : in Number_Base := Default_Base); + +private + pragma Inline (Put); + +end Terminal_Interface.Curses.Text_IO.Modular_IO; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io.adb new file mode 100644 index 0000000..ed7a4c8 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io.adb @@ -0,0 +1,336 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +package body Terminal_Interface.Curses.Text_IO is + + Default_Window : Window := Null_Window; + + procedure Set_Window (Win : in Window) + is + begin + Default_Window := Win; + end Set_Window; + + function Get_Window return Window + is + begin + if Default_Window = Null_Window then + return Standard_Window; + else + return Default_Window; + end if; + end Get_Window; + pragma Inline (Get_Window); + + procedure Flush (Win : in Window) + is + begin + Refresh (Win); + end Flush; + + procedure Flush + is + begin + Flush (Get_Window); + end Flush; + + -------------------------------------------- + -- Specification of line and page lengths -- + -------------------------------------------- + + -- There are no set routines in this package. I assume, that you allocate + -- the window with an appropriate size. + -- A scroll-window is interpreted as an page with unbounded page length, + -- i.e. it returns the conventional 0 as page length. + + function Line_Length (Win : in Window) return Count + is + N_Lines : Line_Count; + N_Cols : Column_Count; + begin + Get_Size (Win, N_Lines, N_Cols); + if Natural (N_Cols) > Natural (Count'Last) then + raise Layout_Error; + end if; + return Count (N_Cols); + end Line_Length; + + function Line_Length return Count + is + begin + return Line_Length (Get_Window); + end Line_Length; + + function Page_Length (Win : in Window) return Count + is + N_Lines : Line_Count; + N_Cols : Column_Count; + begin + if Scrolling_Allowed (Win) then + return 0; + else + Get_Size (Win, N_Lines, N_Cols); + if Natural (N_Lines) > Natural (Count'Last) then + raise Layout_Error; + end if; + return Count (N_Lines); + end if; + end Page_Length; + + function Page_Length return Count + is + begin + return Page_Length (Get_Window); + end Page_Length; + + ------------------------------------ + -- Column, Line, and Page Control -- + ------------------------------------ + procedure New_Line (Win : in Window; Spacing : in Positive_Count := 1) + is + P_Size : constant Count := Page_Length (Win); + begin + if Spacing not in Positive_Count then + raise Constraint_Error; + end if; + + for I in 1 .. Spacing loop + if P_Size > 0 and then Line (Win) >= P_Size then + New_Page (Win); + else + Add (Win, ASCII.LF); + end if; + end loop; + end New_Line; + + procedure New_Line (Spacing : in Positive_Count := 1) + is + begin + New_Line (Get_Window, Spacing); + end New_Line; + + procedure New_Page (Win : in Window) + is + begin + Clear (Win); + end New_Page; + + procedure New_Page + is + begin + New_Page (Get_Window); + end New_Page; + + procedure Set_Col (Win : in Window; To : in Positive_Count) + is + Y : Line_Position; + X1 : Column_Position; + X2 : Column_Position; + N : Natural; + begin + if To not in Positive_Count then + raise Constraint_Error; + end if; + + Get_Cursor_Position (Win, Y, X1); + N := Natural (To); N := N - 1; + X2 := Column_Position (N); + if X1 > X2 then + New_Line (Win, 1); + X1 := 0; + end if; + if X1 < X2 then + declare + Filler : constant String (Integer (X1) .. (Integer (X2) - 1)) + := (others => ' '); + begin + Put (Win, Filler); + end; + end if; + end Set_Col; + + procedure Set_Col (To : in Positive_Count) + is + begin + Set_Col (Get_Window, To); + end Set_Col; + + procedure Set_Line (Win : in Window; To : in Positive_Count) + is + Y1 : Line_Position; + Y2 : Line_Position; + X : Column_Position; + N : Natural; + begin + if To not in Positive_Count then + raise Constraint_Error; + end if; + + Get_Cursor_Position (Win, Y1, X); + N := Natural (To); N := N - 1; + Y2 := Line_Position (N); + if Y2 < Y1 then + New_Page (Win); + Y1 := 0; + end if; + if Y1 < Y2 then + New_Line (Win, Positive_Count (Y2 - Y1)); + end if; + end Set_Line; + + procedure Set_Line (To : in Positive_Count) + is + begin + Set_Line (Get_Window, To); + end Set_Line; + + function Col (Win : in Window) return Positive_Count + is + Y : Line_Position; + X : Column_Position; + N : Natural; + begin + Get_Cursor_Position (Win, Y, X); + N := Natural (X); N := N + 1; + if N > Natural (Count'Last) then + raise Layout_Error; + end if; + return Positive_Count (N); + end Col; + + function Col return Positive_Count + is + begin + return Col (Get_Window); + end Col; + + function Line (Win : in Window) return Positive_Count + is + Y : Line_Position; + X : Column_Position; + N : Natural; + begin + Get_Cursor_Position (Win, Y, X); + N := Natural (Y); N := N + 1; + if N > Natural (Count'Last) then + raise Layout_Error; + end if; + return Positive_Count (N); + end Line; + + function Line return Positive_Count + is + begin + return Line (Get_Window); + end Line; + + ----------------------- + -- Characters Output -- + ----------------------- + + procedure Put (Win : in Window; Item : in Character) + is + P_Size : constant Count := Page_Length (Win); + Y : Line_Position; + X : Column_Position; + L : Line_Count; + C : Column_Count; + begin + if P_Size > 0 then + Get_Cursor_Position (Win, Y, X); + Get_Size (Win, L, C); + if (Y + 1) = L and then (X + 1) = C then + New_Page (Win); + end if; + end if; + Add (Win, Item); + end Put; + + procedure Put (Item : in Character) + is + begin + Put (Get_Window, Item); + end Put; + + -------------------- + -- Strings-Output -- + -------------------- + + procedure Put (Win : in Window; Item : in String) + is + P_Size : constant Count := Page_Length (Win); + Y : Line_Position; + X : Column_Position; + L : Line_Count; + C : Column_Count; + begin + if P_Size > 0 then + Get_Cursor_Position (Win, Y, X); + Get_Size (Win, L, C); + if (Y + 1) = L and then (X + 1 + Item'Length) >= C then + New_Page (Win); + end if; + end if; + Add (Win, Item); + end Put; + + procedure Put (Item : in String) + is + begin + Put (Get_Window, Item); + end Put; + + procedure Put_Line + (Win : in Window; + Item : in String) + is + begin + Put (Win, Item); + New_Line (Win, 1); + end Put_Line; + + procedure Put_Line + (Item : in String) + is + begin + Put_Line (Get_Window, Item); + end Put_Line; + +end Terminal_Interface.Curses.Text_IO; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io.ads b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io.ads new file mode 100644 index 0000000..fa659a8 --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses-text_io.ads @@ -0,0 +1,136 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Ada.Text_IO; +with Ada.IO_Exceptions; + +package Terminal_Interface.Curses.Text_IO is + + use type Ada.Text_IO.Count; + subtype Count is Ada.Text_IO.Count; + subtype Positive_Count is Count range 1 .. Count'Last; + + subtype Field is Ada.Text_IO.Field; + subtype Number_Base is Integer range 2 .. 16; + + type Type_Set is (Lower_Case, Upper_Case, Mixed_Case); + + -- For most of the routines you will see a version without a Window + -- type parameter. They will operate on a default window, which can + -- be set by the user. It is initially equal to Standard_Window. + + procedure Set_Window (Win : in Window); + -- Set Win as the default window + + function Get_Window return Window; + -- Get the current default window + + procedure Flush (Win : in Window); + procedure Flush; + + -------------------------------------------- + -- Specification of line and page lengths -- + -------------------------------------------- + + -- There are no set routines in this package. I assume, that you allocate + -- the window with an appropriate size. + -- A scroll-window is interpreted as an page with unbounded page length, + -- i.e. it returns the conventional 0 as page length. + + function Line_Length (Win : in Window) return Count; + function Line_Length return Count; + + function Page_Length (Win : in Window) return Count; + function Page_Length return Count; + + ------------------------------------ + -- Column, Line, and Page Control -- + ------------------------------------ + procedure New_Line (Win : in Window; Spacing : in Positive_Count := 1); + procedure New_Line (Spacing : in Positive_Count := 1); + + procedure New_Page (Win : in Window); + procedure New_Page; + + procedure Set_Col (Win : in Window; To : in Positive_Count); + procedure Set_Col (To : in Positive_Count); + + procedure Set_Line (Win : in Window; To : in Positive_Count); + procedure Set_Line (To : in Positive_Count); + + function Col (Win : in Window) return Positive_Count; + function Col return Positive_Count; + + function Line (Win : in Window) return Positive_Count; + function Line return Positive_Count; + + ----------------------- + -- Characters-Output -- + ----------------------- + + procedure Put (Win : in Window; Item : in Character); + procedure Put (Item : in Character); + + -------------------- + -- Strings-Output -- + -------------------- + + procedure Put (Win : in Window; Item : in String); + procedure Put (Item : in String); + + procedure Put_Line + (Win : in Window; + Item : in String); + + procedure Put_Line + (Item : in String); + + -- Exceptions + + Status_Error : exception renames Ada.IO_Exceptions.Status_Error; + Mode_Error : exception renames Ada.IO_Exceptions.Mode_Error; + Name_Error : exception renames Ada.IO_Exceptions.Name_Error; + Use_Error : exception renames Ada.IO_Exceptions.Use_Error; + Device_Error : exception renames Ada.IO_Exceptions.Device_Error; + End_Error : exception renames Ada.IO_Exceptions.End_Error; + Data_Error : exception renames Ada.IO_Exceptions.Data_Error; + Layout_Error : exception renames Ada.IO_Exceptions.Layout_Error; + +end Terminal_Interface.Curses.Text_IO; diff --git a/ncurses-5.2/Ada95/src/terminal_interface-curses.adb b/ncurses-5.2/Ada95/src/terminal_interface-curses.adb new file mode 100644 index 0000000..0ca29ea --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface-curses.adb @@ -0,0 +1,2414 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with System; + +with Terminal_Interface.Curses.Aux; +with Interfaces.C; use Interfaces.C; +with Interfaces.C.Strings; use Interfaces.C.Strings; +with Interfaces.C.Pointers; +with Ada.Characters.Handling; use Ada.Characters.Handling; +with Ada.Strings.Fixed; +with Ada.Unchecked_Conversion; + +package body Terminal_Interface.Curses is + + use Aux; + use type System.Bit_Order; + + package ASF renames Ada.Strings.Fixed; + + type chtype_array is array (size_t range <>) + of aliased Attributed_Character; + pragma Convention (C, chtype_array); + +------------------------------------------------------------------------------ + generic + type Element is (<>); + function W_Get_Element (Win : in Window; + Offset : in Natural) return Element; + + function W_Get_Element (Win : in Window; + Offset : in Natural) return Element is + type E_Array is array (Natural range <>) of aliased Element; + package C_E_Array is new + Interfaces.C.Pointers (Natural, Element, E_Array, Element'Val (0)); + use C_E_Array; + + function To_Pointer is new + Ada.Unchecked_Conversion (Window, Pointer); + + P : Pointer := To_Pointer (Win); + begin + if Win = Null_Window then + raise Curses_Exception; + else + P := P + ptrdiff_t (Offset); + return P.all; + end if; + end W_Get_Element; + + function W_Get_Int is new W_Get_Element (C_Int); + function W_Get_Short is new W_Get_Element (C_Short); + function W_Get_Byte is new W_Get_Element (Interfaces.C.unsigned_char); + +------------------------------------------------------------------------------ + function Key_Name (Key : in Real_Key_Code) return String + is + function Keyname (K : C_Int) return chars_ptr; + pragma Import (C, Keyname, "keyname"); + + Ch : Character; + begin + if Key <= Character'Pos (Character'Last) then + Ch := Character'Val (Key); + if Is_Control (Ch) then + return Un_Control (Attributed_Character'(Ch => Ch, + Color => Color_Pair'First, + Attr => Normal_Video)); + elsif Is_Graphic (Ch) then + declare + S : String (1 .. 1); + begin + S (1) := Ch; + return S; + end; + else + return ""; + end if; + else + return Fill_String (Keyname (C_Int (Key))); + end if; + end Key_Name; + + procedure Key_Name (Key : in Real_Key_Code; + Name : out String) + is + begin + ASF.Move (Key_Name (Key), Name); + end Key_Name; + +------------------------------------------------------------------------------ + procedure Init_Screen + is + function Initscr return Window; + pragma Import (C, Initscr, "initscr"); + + W : Window; + begin + W := Initscr; + if W = Null_Window then + raise Curses_Exception; + end if; + end Init_Screen; + + procedure End_Windows + is + function Endwin return C_Int; + pragma Import (C, Endwin, "endwin"); + begin + if Endwin = Curses_Err then + raise Curses_Exception; + end if; + end End_Windows; + + function Is_End_Window return Boolean + is + function Isendwin return Curses_Bool; + pragma Import (C, Isendwin, "isendwin"); + begin + if Isendwin = Curses_Bool_False then + return False; + else + return True; + end if; + end Is_End_Window; +------------------------------------------------------------------------------ + procedure Move_Cursor (Win : in Window := Standard_Window; + Line : in Line_Position; + Column : in Column_Position) + is + function Wmove (Win : Window; + Line : C_Int; + Column : C_Int + ) return C_Int; + pragma Import (C, Wmove, "wmove"); + begin + if Wmove (Win, C_Int (Line), C_Int (Column)) = Curses_Err then + raise Curses_Exception; + end if; + end Move_Cursor; +------------------------------------------------------------------------------ + procedure Add (Win : in Window := Standard_Window; + Ch : in Attributed_Character) + is + function Waddch (W : Window; + Ch : C_Chtype) return C_Int; + pragma Import (C, Waddch, "waddch"); + begin + if Waddch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then + raise Curses_Exception; + end if; + end Add; + + procedure Add (Win : in Window := Standard_Window; + Ch : in Character) + is + begin + Add (Win, + Attributed_Character'(Ch => Ch, + Color => Color_Pair'First, + Attr => Normal_Video)); + end Add; + + procedure Add + (Win : in Window := Standard_Window; + Line : in Line_Position; + Column : in Column_Position; + Ch : in Attributed_Character) + is + function mvwaddch (W : Window; + Y : C_Int; + X : C_Int; + Ch : C_Chtype) return C_Int; + pragma Import (C, mvwaddch, "mvwaddch"); + begin + if mvwaddch (Win, C_Int (Line), + C_Int (Column), + AttrChar_To_Chtype (Ch)) = Curses_Err then + raise Curses_Exception; + end if; + end Add; + + procedure Add + (Win : in Window := Standard_Window; + Line : in Line_Position; + Column : in Column_Position; + Ch : in Character) + is + begin + Add (Win, + Line, + Column, + Attributed_Character'(Ch => Ch, + Color => Color_Pair'First, + Attr => Normal_Video)); + end Add; + + procedure Add_With_Immediate_Echo + (Win : in Window := Standard_Window; + Ch : in Attributed_Character) + is + function Wechochar (W : Window; + Ch : C_Chtype) return C_Int; + pragma Import (C, Wechochar, "wechochar"); + begin + if Wechochar (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then + raise Curses_Exception; + end if; + end Add_With_Immediate_Echo; + + procedure Add_With_Immediate_Echo + (Win : in Window := Standard_Window; + Ch : in Character) + is + begin + Add_With_Immediate_Echo + (Win, + Attributed_Character'(Ch => Ch, + Color => Color_Pair'First, + Attr => Normal_Video)); + end Add_With_Immediate_Echo; +------------------------------------------------------------------------------ + function Create (Number_Of_Lines : Line_Count; + Number_Of_Columns : Column_Count; + First_Line_Position : Line_Position; + First_Column_Position : Column_Position) return Window + is + function Newwin (Number_Of_Lines : C_Int; + Number_Of_Columns : C_Int; + First_Line_Position : C_Int; + First_Column_Position : C_Int) return Window; + pragma Import (C, Newwin, "newwin"); + + W : Window; + begin + W := Newwin (C_Int (Number_Of_Lines), + C_Int (Number_Of_Columns), + C_Int (First_Line_Position), + C_Int (First_Column_Position)); + if W = Null_Window then + raise Curses_Exception; + end if; + return W; + end Create; + + procedure Delete (Win : in out Window) + is + function Wdelwin (W : Window) return C_Int; + pragma Import (C, Wdelwin, "delwin"); + begin + if Wdelwin (Win) = Curses_Err then + raise Curses_Exception; + end if; + Win := Null_Window; + end Delete; + + function Sub_Window + (Win : Window := Standard_Window; + Number_Of_Lines : Line_Count; + Number_Of_Columns : Column_Count; + First_Line_Position : Line_Position; + First_Column_Position : Column_Position) return Window + is + function Subwin + (Win : Window; + Number_Of_Lines : C_Int; + Number_Of_Columns : C_Int; + First_Line_Position : C_Int; + First_Column_Position : C_Int) return Window; + pragma Import (C, Subwin, "subwin"); + + W : Window; + begin + W := Subwin (Win, + C_Int (Number_Of_Lines), + C_Int (Number_Of_Columns), + C_Int (First_Line_Position), + C_Int (First_Column_Position)); + if W = Null_Window then + raise Curses_Exception; + end if; + return W; + end Sub_Window; + + function Derived_Window + (Win : Window := Standard_Window; + Number_Of_Lines : Line_Count; + Number_Of_Columns : Column_Count; + First_Line_Position : Line_Position; + First_Column_Position : Column_Position) return Window + is + function Derwin + (Win : Window; + Number_Of_Lines : C_Int; + Number_Of_Columns : C_Int; + First_Line_Position : C_Int; + First_Column_Position : C_Int) return Window; + pragma Import (C, Derwin, "derwin"); + + W : Window; + begin + W := Derwin (Win, + C_Int (Number_Of_Lines), + C_Int (Number_Of_Columns), + C_Int (First_Line_Position), + C_Int (First_Column_Position)); + if W = Null_Window then + raise Curses_Exception; + end if; + return W; + end Derived_Window; + + function Duplicate (Win : Window) return Window + is + function Dupwin (Win : Window) return Window; + pragma Import (C, Dupwin, "dupwin"); + + W : Window := Dupwin (Win); + begin + if W = Null_Window then + raise Curses_Exception; + end if; + return W; + end Duplicate; + + procedure Move_Window (Win : in Window; + Line : in Line_Position; + Column : in Column_Position) + is + function Mvwin (Win : Window; + Line : C_Int; + Column : C_Int) return C_Int; + pragma Import (C, Mvwin, "mvwin"); + begin + if Mvwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then + raise Curses_Exception; + end if; + end Move_Window; + + procedure Move_Derived_Window (Win : in Window; + Line : in Line_Position; + Column : in Column_Position) + is + function Mvderwin (Win : Window; + Line : C_Int; + Column : C_Int) return C_Int; + pragma Import (C, Mvderwin, "mvderwin"); + begin + if Mvderwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then + raise Curses_Exception; + end if; + end Move_Derived_Window; + + procedure Set_Synch_Mode (Win : in Window := Standard_Window; + Mode : in Boolean := False) + is + function Syncok (Win : Window; + Mode : Curses_Bool) return C_Int; + pragma Import (C, Syncok, "syncok"); + begin + if Syncok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then + raise Curses_Exception; + end if; + end Set_Synch_Mode; +------------------------------------------------------------------------------ + procedure Add (Win : in Window := Standard_Window; + Str : in String; + Len : in Integer := -1) + is + type Char_Ptr is access all Interfaces.C.char; + function Waddnstr (Win : Window; + Str : Char_Ptr; + Len : C_Int := -1) return C_Int; + pragma Import (C, Waddnstr, "waddnstr"); + + Txt : char_array (0 .. Str'Length); + Length : size_t; + begin + To_C (Str, Txt, Length); + if Waddnstr (Win, Txt (Txt'First)'Access, C_Int (Len)) = Curses_Err then + raise Curses_Exception; + end if; + end Add; + + procedure Add + (Win : in Window := Standard_Window; + Line : in Line_Position; + Column : in Column_Position; + Str : in String; + Len : in Integer := -1) + is + begin + Move_Cursor (Win, Line, Column); + Add (Win, Str, Len); + end Add; +------------------------------------------------------------------------------ + procedure Add + (Win : in Window := Standard_Window; + Str : in Attributed_String; + Len : in Integer := -1) + is + type Chtype_Ptr is access all Attributed_Character; + function Waddchnstr (Win : Window; + Str : Chtype_Ptr; + Len : C_Int := -1) return C_Int; + pragma Import (C, Waddchnstr, "waddchnstr"); + + Txt : chtype_array (0 .. Str'Length); + begin + for Length in 1 .. size_t (Str'Length) loop + Txt (Length - 1) := Str (Natural (Length)); + end loop; + Txt (Str'Length) := Default_Character; + if Waddchnstr (Win, + Txt (Txt'First)'Access, + C_Int (Len)) = Curses_Err then + raise Curses_Exception; + end if; + end Add; + + procedure Add + (Win : in Window := Standard_Window; + Line : in Line_Position; + Column : in Column_Position; + Str : in Attributed_String; + Len : in Integer := -1) + is + begin + Move_Cursor (Win, Line, Column); + Add (Win, Str, Len); + end Add; +------------------------------------------------------------------------------ + procedure Border + (Win : in Window := Standard_Window; + Left_Side_Symbol : in Attributed_Character := Default_Character; + Right_Side_Symbol : in Attributed_Character := Default_Character; + Top_Side_Symbol : in Attributed_Character := Default_Character; + Bottom_Side_Symbol : in Attributed_Character := Default_Character; + Upper_Left_Corner_Symbol : in Attributed_Character := Default_Character; + Upper_Right_Corner_Symbol : in Attributed_Character := Default_Character; + Lower_Left_Corner_Symbol : in Attributed_Character := Default_Character; + Lower_Right_Corner_Symbol : in Attributed_Character := Default_Character) + is + function Wborder (W : Window; + LS : C_Chtype; + RS : C_Chtype; + TS : C_Chtype; + BS : C_Chtype; + ULC : C_Chtype; + URC : C_Chtype; + LLC : C_Chtype; + LRC : C_Chtype) return C_Int; + pragma Import (C, Wborder, "wborder"); + begin + if Wborder (Win, + AttrChar_To_Chtype (Left_Side_Symbol), + AttrChar_To_Chtype (Right_Side_Symbol), + AttrChar_To_Chtype (Top_Side_Symbol), + AttrChar_To_Chtype (Bottom_Side_Symbol), + AttrChar_To_Chtype (Upper_Left_Corner_Symbol), + AttrChar_To_Chtype (Upper_Right_Corner_Symbol), + AttrChar_To_Chtype (Lower_Left_Corner_Symbol), + AttrChar_To_Chtype (Lower_Right_Corner_Symbol) + ) = Curses_Err + then + raise Curses_Exception; + end if; + end Border; + + procedure Box + (Win : in Window := Standard_Window; + Vertical_Symbol : in Attributed_Character := Default_Character; + Horizontal_Symbol : in Attributed_Character := Default_Character) + is + begin + Border (Win, + Vertical_Symbol, Vertical_Symbol, + Horizontal_Symbol, Horizontal_Symbol); + end Box; + + procedure Horizontal_Line + (Win : in Window := Standard_Window; + Line_Size : in Natural; + Line_Symbol : in Attributed_Character := Default_Character) + is + function Whline (W : Window; + Ch : C_Chtype; + Len : C_Int) return C_Int; + pragma Import (C, Whline, "whline"); + begin + if Whline (Win, + AttrChar_To_Chtype (Line_Symbol), + C_Int (Line_Size)) = Curses_Err then + raise Curses_Exception; + end if; + end Horizontal_Line; + + procedure Vertical_Line + (Win : in Window := Standard_Window; + Line_Size : in Natural; + Line_Symbol : in Attributed_Character := Default_Character) + is + function Wvline (W : Window; + Ch : C_Chtype; + Len : C_Int) return C_Int; + pragma Import (C, Wvline, "wvline"); + begin + if Wvline (Win, + AttrChar_To_Chtype (Line_Symbol), + C_Int (Line_Size)) = Curses_Err then + raise Curses_Exception; + end if; + end Vertical_Line; + +------------------------------------------------------------------------------ + function Get_Keystroke (Win : Window := Standard_Window) + return Real_Key_Code + is + function Wgetch (W : Window) return C_Int; + pragma Import (C, Wgetch, "wgetch"); + + C : constant C_Int := Wgetch (Win); + begin + if C = Curses_Err then + return Key_None; + else + return Real_Key_Code (C); + end if; + end Get_Keystroke; + + procedure Undo_Keystroke (Key : in Real_Key_Code) + is + function Ungetch (Ch : C_Int) return C_Int; + pragma Import (C, Ungetch, "ungetch"); + begin + if Ungetch (C_Int (Key)) = Curses_Err then + raise Curses_Exception; + end if; + end Undo_Keystroke; + + function Has_Key (Key : Special_Key_Code) return Boolean + is + function Haskey (Key : C_Int) return C_Int; + pragma Import (C, Haskey, "has_key"); + begin + if Haskey (C_Int (Key)) = Curses_False then + return False; + else + return True; + end if; + end Has_Key; + + function Is_Function_Key (Key : Special_Key_Code) return Boolean + is + L : constant Special_Key_Code := Special_Key_Code (Natural (Key_F0) + + Natural (Function_Key_Number'Last)); + begin + if (Key >= Key_F0) and then (Key <= L) then + return True; + else + return False; + end if; + end Is_Function_Key; + + function Function_Key (Key : Real_Key_Code) + return Function_Key_Number + is + begin + if Is_Function_Key (Key) then + return Function_Key_Number (Key - Key_F0); + else + raise Constraint_Error; + end if; + end Function_Key; + + function Function_Key_Code (Key : Function_Key_Number) return Real_Key_Code + is + begin + return Real_Key_Code (Natural (Key_F0) + Natural (Key)); + end Function_Key_Code; +------------------------------------------------------------------------------ + procedure Switch_Character_Attribute + (Win : in Window := Standard_Window; + Attr : in Character_Attribute_Set := Normal_Video; + On : in Boolean := True) + is + function Wattron (Win : Window; + C_Attr : C_AttrType) return C_Int; + pragma Import (C, Wattron, "wattr_on"); + function Wattroff (Win : Window; + C_Attr : C_AttrType) return C_Int; + pragma Import (C, Wattroff, "wattr_off"); + -- In Ada we use the On Boolean to control whether or not we want to + -- switch on or off the attributes in the set. + Err : C_Int; + AC : constant Attributed_Character := (Ch => Character'First, + Color => Color_Pair'First, + Attr => Attr); + begin + if On then + Err := Wattron (Win, AttrChar_To_AttrType (AC)); + else + Err := Wattroff (Win, AttrChar_To_AttrType (AC)); + end if; + if Err = Curses_Err then + raise Curses_Exception; + end if; + end Switch_Character_Attribute; + + procedure Set_Character_Attributes + (Win : in Window := Standard_Window; + Attr : in Character_Attribute_Set := Normal_Video; + Color : in Color_Pair := Color_Pair'First) + is + function Wattrset (Win : Window; + C_Attr : C_AttrType) return C_Int; + pragma Import (C, Wattrset, "wattrset"); -- ??? wattr_set + begin + if Wattrset (Win, + AttrChar_To_AttrType (Attributed_Character' + (Ch => Character'First, + Color => Color, + Attr => Attr))) = Curses_Err then + raise Curses_Exception; + end if; + end Set_Character_Attributes; + + function Get_Character_Attribute (Win : Window := Standard_Window) + return Character_Attribute_Set + is + function Wattrget (Win : Window; + Atr : access C_AttrType; + Col : access C_Short; + Opt : System.Address) return C_Int; + pragma Import (C, Wattrget, "wattr_get"); + + Attr : aliased C_AttrType; + Col : aliased C_Short; + Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access, + System.Null_Address); + Ch : Attributed_Character; + begin + if Res = Curses_Ok then + Ch := AttrType_To_AttrChar (Attr); + return Ch.Attr; + else + raise Curses_Exception; + end if; + end Get_Character_Attribute; + + function Get_Character_Attribute (Win : Window := Standard_Window) + return Color_Pair + is + function Wattrget (Win : Window; + Atr : access C_AttrType; + Col : access C_Short; + Opt : System.Address) return C_Int; + pragma Import (C, Wattrget, "wattr_get"); + + Attr : aliased C_AttrType; + Col : aliased C_Short; + Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access, + System.Null_Address); + Ch : Attributed_Character; + begin + if Res = Curses_Ok then + Ch := AttrType_To_AttrChar (Attr); + return Ch.Color; + else + raise Curses_Exception; + end if; + end Get_Character_Attribute; + + procedure Set_Color (Win : in Window := Standard_Window; + Pair : in Color_Pair) + is + function Wset_Color (Win : Window; + Color : C_Short; + Opts : C_Void_Ptr) return C_Int; + pragma Import (C, Wset_Color, "wcolor_set"); + begin + if Wset_Color (Win, + C_Short (Pair), + C_Void_Ptr (System.Null_Address)) = Curses_Err then + raise Curses_Exception; + end if; + end Set_Color; + + procedure Change_Attributes + (Win : in Window := Standard_Window; + Count : in Integer := -1; + Attr : in Character_Attribute_Set := Normal_Video; + Color : in Color_Pair := Color_Pair'First) + is + function Wchgat (Win : Window; + Cnt : C_Int; + Attr : C_AttrType; + Color : C_Short; + Opts : System.Address := System.Null_Address) + return C_Int; + pragma Import (C, Wchgat, "wchgat"); + + Ch : constant Attributed_Character := + (Ch => Character'First, Color => Color_Pair'First, Attr => Attr); + begin + if Wchgat (Win, C_Int (Count), AttrChar_To_AttrType (Ch), + C_Short (Color)) = Curses_Err then + raise Curses_Exception; + end if; + end Change_Attributes; + + procedure Change_Attributes + (Win : in Window := Standard_Window; + Line : in Line_Position := Line_Position'First; + Column : in Column_Position := Column_Position'First; + Count : in Integer := -1; + Attr : in Character_Attribute_Set := Normal_Video; + Color : in Color_Pair := Color_Pair'First) + is + begin + Move_Cursor (Win, Line, Column); + Change_Attributes (Win, Count, Attr, Color); + end Change_Attributes; +------------------------------------------------------------------------------ + procedure Beep + is + function Beeper return C_Int; + pragma Import (C, Beeper, "beep"); + begin + if Beeper = Curses_Err then + raise Curses_Exception; + end if; + end Beep; + + procedure Flash_Screen + is + function Flash return C_Int; + pragma Import (C, Flash, "flash"); + begin + if Flash = Curses_Err then + raise Curses_Exception; + end if; + end Flash_Screen; +------------------------------------------------------------------------------ + procedure Set_Cbreak_Mode (SwitchOn : in Boolean := True) + is + function Cbreak return C_Int; + pragma Import (C, Cbreak, "cbreak"); + function NoCbreak return C_Int; + pragma Import (C, NoCbreak, "nocbreak"); + + Err : C_Int; + begin + if SwitchOn then + Err := Cbreak; + else + Err := NoCbreak; + end if; + if Err = Curses_Err then + raise Curses_Exception; + end if; + end Set_Cbreak_Mode; + + procedure Set_Raw_Mode (SwitchOn : in Boolean := True) + is + function Raw return C_Int; + pragma Import (C, Raw, "raw"); + function NoRaw return C_Int; + pragma Import (C, NoRaw, "noraw"); + + Err : C_Int; + begin + if SwitchOn then + Err := Raw; + else + Err := NoRaw; + end if; + if Err = Curses_Err then + raise Curses_Exception; + end if; + end Set_Raw_Mode; + + procedure Set_Echo_Mode (SwitchOn : in Boolean := True) + is + function Echo return C_Int; + pragma Import (C, Echo, "echo"); + function NoEcho return C_Int; + pragma Import (C, NoEcho, "noecho"); + + Err : C_Int; + begin + if SwitchOn then + Err := Echo; + else + Err := NoEcho; + end if; + if Err = Curses_Err then + raise Curses_Exception; + end if; + end Set_Echo_Mode; + + procedure Set_Meta_Mode (Win : in Window := Standard_Window; + SwitchOn : in Boolean := True) + is + function Meta (W : Window; Mode : Curses_Bool) return C_Int; + pragma Import (C, Meta, "meta"); + begin + if Meta (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then + raise Curses_Exception; + end if; + end Set_Meta_Mode; + + procedure Set_KeyPad_Mode (Win : in Window := Standard_Window; + SwitchOn : in Boolean := True) + is + function Keypad (W : Window; Mode : Curses_Bool) return C_Int; + pragma Import (C, Keypad, "keypad"); + begin + if Keypad (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then + raise Curses_Exception; + end if; + end Set_KeyPad_Mode; + + procedure Half_Delay (Amount : in Half_Delay_Amount) + is + function Halfdelay (Amount : C_Int) return C_Int; + pragma Import (C, Halfdelay, "halfdelay"); + begin + if Halfdelay (C_Int (Amount)) = Curses_Err then + raise Curses_Exception; + end if; + end Half_Delay; + + procedure Set_Flush_On_Interrupt_Mode + (Win : in Window := Standard_Window; + Mode : in Boolean := True) + is + function Intrflush (Win : Window; Mode : Curses_Bool) return C_Int; + pragma Import (C, Intrflush, "intrflush"); + begin + if Intrflush (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then + raise Curses_Exception; + end if; + end Set_Flush_On_Interrupt_Mode; + + procedure Set_Queue_Interrupt_Mode + (Win : in Window := Standard_Window; + Flush : in Boolean := True) + is + procedure Qiflush; + pragma Import (C, Qiflush, "qiflush"); + procedure No_Qiflush; + pragma Import (C, No_Qiflush, "noqiflush"); + begin + if Flush then + Qiflush; + else + No_Qiflush; + end if; + end Set_Queue_Interrupt_Mode; + + procedure Set_NoDelay_Mode + (Win : in Window := Standard_Window; + Mode : in Boolean := False) + is + function Nodelay (Win : Window; Mode : Curses_Bool) return C_Int; + pragma Import (C, Nodelay, "nodelay"); + begin + if Nodelay (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then + raise Curses_Exception; + end if; + end Set_NoDelay_Mode; + + procedure Set_Timeout_Mode (Win : in Window := Standard_Window; + Mode : in Timeout_Mode; + Amount : in Natural) + is + function Wtimeout (Win : Window; Amount : C_Int) return C_Int; + pragma Import (C, Wtimeout, "wtimeout"); + + Time : C_Int; + begin + case Mode is + when Blocking => Time := -1; + when Non_Blocking => Time := 0; + when Delayed => + if Amount = 0 then + raise Constraint_Error; + end if; + Time := C_Int (Amount); + end case; + if Wtimeout (Win, Time) = Curses_Err then + raise Curses_Exception; + end if; + end Set_Timeout_Mode; + + procedure Set_Escape_Timer_Mode + (Win : in Window := Standard_Window; + Timer_Off : in Boolean := False) + is + function Notimeout (Win : Window; Mode : Curses_Bool) return C_Int; + pragma Import (C, Notimeout, "notimeout"); + begin + if Notimeout (Win, Curses_Bool (Boolean'Pos (Timer_Off))) + = Curses_Err then + raise Curses_Exception; + end if; + end Set_Escape_Timer_Mode; + +------------------------------------------------------------------------------ + procedure Set_NL_Mode (SwitchOn : in Boolean := True) + is + function NL return C_Int; + pragma Import (C, NL, "nl"); + function NoNL return C_Int; + pragma Import (C, NoNL, "nonl"); + + Err : C_Int; + begin + if SwitchOn then + Err := NL; + else + Err := NoNL; + end if; + if Err = Curses_Err then + raise Curses_Exception; + end if; + end Set_NL_Mode; + + procedure Clear_On_Next_Update + (Win : in Window := Standard_Window; + Do_Clear : in Boolean := True) + is + function Clear_Ok (W : Window; Flag : Curses_Bool) return C_Int; + pragma Import (C, Clear_Ok, "clearok"); + begin + if Clear_Ok (Win, Curses_Bool (Boolean'Pos (Do_Clear))) = Curses_Err then + raise Curses_Exception; + end if; + end Clear_On_Next_Update; + + procedure Use_Insert_Delete_Line + (Win : in Window := Standard_Window; + Do_Idl : in Boolean := True) + is + function IDL_Ok (W : Window; Flag : Curses_Bool) return C_Int; + pragma Import (C, IDL_Ok, "idlok"); + begin + if IDL_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idl))) = Curses_Err then + raise Curses_Exception; + end if; + end Use_Insert_Delete_Line; + + procedure Use_Insert_Delete_Character + (Win : in Window := Standard_Window; + Do_Idc : in Boolean := True) + is + function IDC_Ok (W : Window; Flag : Curses_Bool) return C_Int; + pragma Import (C, IDC_Ok, "idcok"); + begin + if IDC_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idc))) = Curses_Err then + raise Curses_Exception; + end if; + end Use_Insert_Delete_Character; + + procedure Leave_Cursor_After_Update + (Win : in Window := Standard_Window; + Do_Leave : in Boolean := True) + is + function Leave_Ok (W : Window; Flag : Curses_Bool) return C_Int; + pragma Import (C, Leave_Ok, "leaveok"); + begin + if Leave_Ok (Win, Curses_Bool (Boolean'Pos (Do_Leave))) = Curses_Err then + raise Curses_Exception; + end if; + end Leave_Cursor_After_Update; + + procedure Immediate_Update_Mode + (Win : in Window := Standard_Window; + Mode : in Boolean := False) + is + function Immedok (Win : Window; Mode : Curses_Bool) return C_Int; + pragma Import (C, Immedok, "immedok"); + begin + if Immedok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then + raise Curses_Exception; + end if; + end Immediate_Update_Mode; + + procedure Allow_Scrolling + (Win : in Window := Standard_Window; + Mode : in Boolean := False) + is + function Scrollok (Win : Window; Mode : Curses_Bool) return C_Int; + pragma Import (C, Scrollok, "scrollok"); + begin + if Scrollok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then + raise Curses_Exception; + end if; + end Allow_Scrolling; + + function Scrolling_Allowed (Win : Window := Standard_Window) return Boolean + is + Res : C_Int; + begin + case Sizeof_bool is + when 1 => Res := C_Int (W_Get_Byte (Win, Offset_scroll)); + when 2 => Res := C_Int (W_Get_Short (Win, Offset_scroll)); + when 4 => Res := C_Int (W_Get_Int (Win, Offset_scroll)); + when others => raise Curses_Exception; + end case; + + case Res is + when 0 => return False; + when others => return True; + end case; + end Scrolling_Allowed; + + procedure Set_Scroll_Region + (Win : in Window := Standard_Window; + Top_Line : in Line_Position; + Bottom_Line : in Line_Position) + is + function Wsetscrreg (Win : Window; + Lin : C_Int; + Col : C_Int) return C_Int; + pragma Import (C, Wsetscrreg, "wsetscrreg"); + begin + if Wsetscrreg (Win, C_Int (Top_Line), C_Int (Bottom_Line)) + = Curses_Err then + raise Curses_Exception; + end if; + end Set_Scroll_Region; +------------------------------------------------------------------------------ + procedure Update_Screen + is + function Do_Update return C_Int; + pragma Import (C, Do_Update, "doupdate"); + begin + if Do_Update = Curses_Err then + raise Curses_Exception; + end if; + end Update_Screen; + + procedure Refresh (Win : in Window := Standard_Window) + is + function Wrefresh (W : Window) return C_Int; + pragma Import (C, Wrefresh, "wrefresh"); + begin + if Wrefresh (Win) = Curses_Err then + raise Curses_Exception; + end if; + end Refresh; + + procedure Refresh_Without_Update + (Win : in Window := Standard_Window) + is + function Wnoutrefresh (W : Window) return C_Int; + pragma Import (C, Wnoutrefresh, "wnoutrefresh"); + begin + if Wnoutrefresh (Win) = Curses_Err then + raise Curses_Exception; + end if; + end Refresh_Without_Update; + + procedure Redraw (Win : in Window := Standard_Window) + is + function Redrawwin (Win : Window) return C_Int; + pragma Import (C, Redrawwin, "redrawwin"); + begin + if Redrawwin (Win) = Curses_Err then + raise Curses_Exception; + end if; + end Redraw; + + procedure Redraw + (Win : in Window := Standard_Window; + Begin_Line : in Line_Position; + Line_Count : in Positive) + is + function Wredrawln (Win : Window; First : C_Int; Cnt : C_Int) + return C_Int; + pragma Import (C, Wredrawln, "wredrawln"); + begin + if Wredrawln (Win, + C_Int (Begin_Line), + C_Int (Line_Count)) = Curses_Err then + raise Curses_Exception; + end if; + end Redraw; + +------------------------------------------------------------------------------ + procedure Erase (Win : in Window := Standard_Window) + is + function Werase (W : Window) return C_Int; + pragma Import (C, Werase, "werase"); + begin + if Werase (Win) = Curses_Err then + raise Curses_Exception; + end if; + end Erase; + + procedure Clear (Win : in Window := Standard_Window) + is + function Wclear (W : Window) return C_Int; + pragma Import (C, Wclear, "wclear"); + begin + if Wclear (Win) = Curses_Err then + raise Curses_Exception; + end if; + end Clear; + + procedure Clear_To_End_Of_Screen (Win : in Window := Standard_Window) + is + function Wclearbot (W : Window) return C_Int; + pragma Import (C, Wclearbot, "wclrtobot"); + begin + if Wclearbot (Win) = Curses_Err then + raise Curses_Exception; + end if; + end Clear_To_End_Of_Screen; + + procedure Clear_To_End_Of_Line (Win : in Window := Standard_Window) + is + function Wcleareol (W : Window) return C_Int; + pragma Import (C, Wcleareol, "wclrtoeol"); + begin + if Wcleareol (Win) = Curses_Err then + raise Curses_Exception; + end if; + end Clear_To_End_Of_Line; +------------------------------------------------------------------------------ + procedure Set_Background + (Win : in Window := Standard_Window; + Ch : in Attributed_Character) + is + procedure WBackground (W : in Window; Ch : in C_Chtype); + pragma Import (C, WBackground, "wbkgdset"); + begin + WBackground (Win, AttrChar_To_Chtype (Ch)); + end Set_Background; + + procedure Change_Background + (Win : in Window := Standard_Window; + Ch : in Attributed_Character) + is + function WChangeBkgd (W : Window; Ch : C_Chtype) return C_Int; + pragma Import (C, WChangeBkgd, "wbkgd"); + begin + if WChangeBkgd (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then + raise Curses_Exception; + end if; + end Change_Background; + + function Get_Background (Win : Window := Standard_Window) + return Attributed_Character + is + function Wgetbkgd (Win : Window) return C_Chtype; + pragma Import (C, Wgetbkgd, "getbkgd"); + begin + return Chtype_To_AttrChar (Wgetbkgd (Win)); + end Get_Background; +------------------------------------------------------------------------------ + procedure Change_Lines_Status (Win : in Window := Standard_Window; + Start : in Line_Position; + Count : in Positive; + State : in Boolean) + is + function Wtouchln (Win : Window; + Sta : C_Int; + Cnt : C_Int; + Chg : C_Int) return C_Int; + pragma Import (C, Wtouchln, "wtouchln"); + begin + if Wtouchln (Win, C_Int (Start), C_Int (Count), + C_Int (Boolean'Pos (State))) = Curses_Err then + raise Curses_Exception; + end if; + end Change_Lines_Status; + + procedure Touch (Win : in Window := Standard_Window) + is + Y : Line_Position; + X : Column_Position; + begin + Get_Size (Win, Y, X); + Change_Lines_Status (Win, 0, Positive (Y), True); + end Touch; + + procedure Untouch (Win : in Window := Standard_Window) + is + Y : Line_Position; + X : Column_Position; + begin + Get_Size (Win, Y, X); + Change_Lines_Status (Win, 0, Positive (Y), False); + end Untouch; + + procedure Touch (Win : in Window := Standard_Window; + Start : in Line_Position; + Count : in Positive) + is + begin + Change_Lines_Status (Win, Start, Count, True); + end Touch; + + function Is_Touched + (Win : Window := Standard_Window; + Line : Line_Position) return Boolean + is + function WLineTouched (W : Window; L : C_Int) return Curses_Bool; + pragma Import (C, WLineTouched, "is_linetouched"); + begin + if WLineTouched (Win, C_Int (Line)) = Curses_Bool_False then + return False; + else + return True; + end if; + end Is_Touched; + + function Is_Touched + (Win : Window := Standard_Window) return Boolean + is + function WWinTouched (W : Window) return Curses_Bool; + pragma Import (C, WWinTouched, "is_wintouched"); + begin + if WWinTouched (Win) = Curses_Bool_False then + return False; + else + return True; + end if; + end Is_Touched; +------------------------------------------------------------------------------ + procedure Copy + (Source_Window : in Window; + Destination_Window : in Window; + Source_Top_Row : in Line_Position; + Source_Left_Column : in Column_Position; + Destination_Top_Row : in Line_Position; + Destination_Left_Column : in Column_Position; + Destination_Bottom_Row : in Line_Position; + Destination_Right_Column : in Column_Position; + Non_Destructive_Mode : in Boolean := True) + is + function Copywin (Src : Window; + Dst : Window; + Str : C_Int; + Slc : C_Int; + Dtr : C_Int; + Dlc : C_Int; + Dbr : C_Int; + Drc : C_Int; + Ndm : C_Int) return C_Int; + pragma Import (C, Copywin, "copywin"); + begin + if Copywin (Source_Window, + Destination_Window, + C_Int (Source_Top_Row), + C_Int (Source_Left_Column), + C_Int (Destination_Top_Row), + C_Int (Destination_Left_Column), + C_Int (Destination_Bottom_Row), + C_Int (Destination_Right_Column), + Boolean'Pos (Non_Destructive_Mode) + ) = Curses_Err then + raise Curses_Exception; + end if; + end Copy; + + procedure Overwrite + (Source_Window : in Window; + Destination_Window : in Window) + is + function Overwrite (Src : Window; Dst : Window) return C_Int; + pragma Import (C, Overwrite, "overwrite"); + begin + if Overwrite (Source_Window, Destination_Window) = Curses_Err then + raise Curses_Exception; + end if; + end Overwrite; + + procedure Overlay + (Source_Window : in Window; + Destination_Window : in Window) + is + function Overlay (Src : Window; Dst : Window) return C_Int; + pragma Import (C, Overlay, "overlay"); + begin + if Overlay (Source_Window, Destination_Window) = Curses_Err then + raise Curses_Exception; + end if; + end Overlay; + +------------------------------------------------------------------------------ + procedure Insert_Delete_Lines + (Win : in Window := Standard_Window; + Lines : in Integer := 1) -- default is to insert one line above + is + function Winsdelln (W : Window; N : C_Int) return C_Int; + pragma Import (C, Winsdelln, "winsdelln"); + begin + if Winsdelln (Win, C_Int (Lines)) = Curses_Err then + raise Curses_Exception; + end if; + end Insert_Delete_Lines; + + procedure Delete_Line (Win : in Window := Standard_Window) + is + begin + Insert_Delete_Lines (Win, -1); + end Delete_Line; + + procedure Insert_Line (Win : in Window := Standard_Window) + is + begin + Insert_Delete_Lines (Win, 1); + end Insert_Line; +------------------------------------------------------------------------------ + + + procedure Get_Size + (Win : in Window := Standard_Window; + Number_Of_Lines : out Line_Count; + Number_Of_Columns : out Column_Count) + is + -- Please note: in ncurses they are one off. + -- This might be different in other implementations of curses + Y : C_Int := C_Int (W_Get_Short (Win, Offset_maxy)) + C_Int (Offset_XY); + X : C_Int := C_Int (W_Get_Short (Win, Offset_maxx)) + C_Int (Offset_XY); + begin + Number_Of_Lines := Line_Count (Y); + Number_Of_Columns := Column_Count (X); + end Get_Size; + + procedure Get_Window_Position + (Win : in Window := Standard_Window; + Top_Left_Line : out Line_Position; + Top_Left_Column : out Column_Position) + is + Y : C_Short := W_Get_Short (Win, Offset_begy); + X : C_Short := W_Get_Short (Win, Offset_begx); + begin + Top_Left_Line := Line_Position (Y); + Top_Left_Column := Column_Position (X); + end Get_Window_Position; + + procedure Get_Cursor_Position + (Win : in Window := Standard_Window; + Line : out Line_Position; + Column : out Column_Position) + is + Y : C_Short := W_Get_Short (Win, Offset_cury); + X : C_Short := W_Get_Short (Win, Offset_curx); + begin + Line := Line_Position (Y); + Column := Column_Position (X); + end Get_Cursor_Position; + + procedure Get_Origin_Relative_To_Parent + (Win : in Window; + Top_Left_Line : out Line_Position; + Top_Left_Column : out Column_Position; + Is_Not_A_Subwindow : out Boolean) + is + Y : C_Int := W_Get_Int (Win, Offset_pary); + X : C_Int := W_Get_Int (Win, Offset_parx); + begin + if Y = -1 then + Top_Left_Line := Line_Position'Last; + Top_Left_Column := Column_Position'Last; + Is_Not_A_Subwindow := True; + else + Top_Left_Line := Line_Position (Y); + Top_Left_Column := Column_Position (X); + Is_Not_A_Subwindow := False; + end if; + end Get_Origin_Relative_To_Parent; +------------------------------------------------------------------------------ + function New_Pad (Lines : Line_Count; + Columns : Column_Count) return Window + is + function Newpad (Lines : C_Int; Columns : C_Int) return Window; + pragma Import (C, Newpad, "newpad"); + + W : Window; + begin + W := Newpad (C_Int (Lines), C_Int (Columns)); + if W = Null_Window then + raise Curses_Exception; + end if; + return W; + end New_Pad; + + function Sub_Pad + (Pad : Window; + Number_Of_Lines : Line_Count; + Number_Of_Columns : Column_Count; + First_Line_Position : Line_Position; + First_Column_Position : Column_Position) return Window + is + function Subpad + (Pad : Window; + Number_Of_Lines : C_Int; + Number_Of_Columns : C_Int; + First_Line_Position : C_Int; + First_Column_Position : C_Int) return Window; + pragma Import (C, Subpad, "subpad"); + + W : Window; + begin + W := Subpad (Pad, + C_Int (Number_Of_Lines), + C_Int (Number_Of_Columns), + C_Int (First_Line_Position), + C_Int (First_Column_Position)); + if W = Null_Window then + raise Curses_Exception; + end if; + return W; + end Sub_Pad; + + procedure Refresh + (Pad : in Window; + Source_Top_Row : in Line_Position; + Source_Left_Column : in Column_Position; + Destination_Top_Row : in Line_Position; + Destination_Left_Column : in Column_Position; + Destination_Bottom_Row : in Line_Position; + Destination_Right_Column : in Column_Position) + is + function Prefresh + (Pad : Window; + Source_Top_Row : C_Int; + Source_Left_Column : C_Int; + Destination_Top_Row : C_Int; + Destination_Left_Column : C_Int; + Destination_Bottom_Row : C_Int; + Destination_Right_Column : C_Int) return C_Int; + pragma Import (C, Prefresh, "prefresh"); + begin + if Prefresh (Pad, + C_Int (Source_Top_Row), + C_Int (Source_Left_Column), + C_Int (Destination_Top_Row), + C_Int (Destination_Left_Column), + C_Int (Destination_Bottom_Row), + C_Int (Destination_Right_Column)) = Curses_Err then + raise Curses_Exception; + end if; + end Refresh; + + procedure Refresh_Without_Update + (Pad : in Window; + Source_Top_Row : in Line_Position; + Source_Left_Column : in Column_Position; + Destination_Top_Row : in Line_Position; + Destination_Left_Column : in Column_Position; + Destination_Bottom_Row : in Line_Position; + Destination_Right_Column : in Column_Position) + is + function Pnoutrefresh + (Pad : Window; + Source_Top_Row : C_Int; + Source_Left_Column : C_Int; + Destination_Top_Row : C_Int; + Destination_Left_Column : C_Int; + Destination_Bottom_Row : C_Int; + Destination_Right_Column : C_Int) return C_Int; + pragma Import (C, Pnoutrefresh, "pnoutrefresh"); + begin + if Pnoutrefresh (Pad, + C_Int (Source_Top_Row), + C_Int (Source_Left_Column), + C_Int (Destination_Top_Row), + C_Int (Destination_Left_Column), + C_Int (Destination_Bottom_Row), + C_Int (Destination_Right_Column)) = Curses_Err then + raise Curses_Exception; + end if; + end Refresh_Without_Update; + + procedure Add_Character_To_Pad_And_Echo_It + (Pad : in Window; + Ch : in Attributed_Character) + is + function Pechochar (Pad : Window; Ch : C_Chtype) + return C_Int; + pragma Import (C, Pechochar, "pechochar"); + begin + if Pechochar (Pad, AttrChar_To_Chtype (Ch)) = Curses_Err then + raise Curses_Exception; + end if; + end Add_Character_To_Pad_And_Echo_It; + + procedure Add_Character_To_Pad_And_Echo_It + (Pad : in Window; + Ch : in Character) + is + begin + Add_Character_To_Pad_And_Echo_It + (Pad, + Attributed_Character'(Ch => Ch, + Color => Color_Pair'First, + Attr => Normal_Video)); + end Add_Character_To_Pad_And_Echo_It; +------------------------------------------------------------------------------ + procedure Scroll (Win : in Window := Standard_Window; + Amount : in Integer := 1) + is + function Wscrl (Win : Window; N : C_Int) return C_Int; + pragma Import (C, Wscrl, "wscrl"); + + begin + if Wscrl (Win, C_Int (Amount)) = Curses_Err then + raise Curses_Exception; + end if; + end Scroll; + +------------------------------------------------------------------------------ + procedure Delete_Character (Win : in Window := Standard_Window) + is + function Wdelch (Win : Window) return C_Int; + pragma Import (C, Wdelch, "wdelch"); + begin + if Wdelch (Win) = Curses_Err then + raise Curses_Exception; + end if; + end Delete_Character; + + procedure Delete_Character + (Win : in Window := Standard_Window; + Line : in Line_Position; + Column : in Column_Position) + is + function Mvwdelch (Win : Window; + Lin : C_Int; + Col : C_Int) return C_Int; + pragma Import (C, Mvwdelch, "mvwdelch"); + begin + if Mvwdelch (Win, C_Int (Line), C_Int (Column)) = Curses_Err then + raise Curses_Exception; + end if; + end Delete_Character; +------------------------------------------------------------------------------ + function Peek (Win : Window := Standard_Window) + return Attributed_Character + is + function Winch (Win : Window) return C_Chtype; + pragma Import (C, Winch, "winch"); + begin + return Chtype_To_AttrChar (Winch (Win)); + end Peek; + + function Peek + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position) return Attributed_Character + is + function Mvwinch (Win : Window; + Lin : C_Int; + Col : C_Int) return C_Chtype; + pragma Import (C, Mvwinch, "mvwinch"); + begin + return Chtype_To_AttrChar (Mvwinch (Win, C_Int (Line), C_Int (Column))); + end Peek; +------------------------------------------------------------------------------ + procedure Insert (Win : in Window := Standard_Window; + Ch : in Attributed_Character) + is + function Winsch (Win : Window; Ch : C_Chtype) return C_Int; + pragma Import (C, Winsch, "winsch"); + begin + if Winsch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then + raise Curses_Exception; + end if; + end Insert; + + procedure Insert + (Win : in Window := Standard_Window; + Line : in Line_Position; + Column : in Column_Position; + Ch : in Attributed_Character) + is + function Mvwinsch (Win : Window; + Lin : C_Int; + Col : C_Int; + Ch : C_Chtype) return C_Int; + pragma Import (C, Mvwinsch, "mvwinsch"); + begin + if Mvwinsch (Win, + C_Int (Line), + C_Int (Column), + AttrChar_To_Chtype (Ch)) = Curses_Err then + raise Curses_Exception; + end if; + end Insert; +------------------------------------------------------------------------------ + procedure Insert (Win : in Window := Standard_Window; + Str : in String; + Len : in Integer := -1) + is + type Char_Ptr is access all Interfaces.C.char; + function Winsnstr (Win : Window; + Str : Char_Ptr; + Len : Integer := -1) return C_Int; + pragma Import (C, Winsnstr, "winsnstr"); + + Txt : char_array (0 .. Str'Length); + Length : size_t; + begin + To_C (Str, Txt, Length); + if Winsnstr (Win, Txt (Txt'First)'Access, Len) = Curses_Err then + raise Curses_Exception; + end if; + end Insert; + + procedure Insert + (Win : in Window := Standard_Window; + Line : in Line_Position; + Column : in Column_Position; + Str : in String; + Len : in Integer := -1) + is + type Char_Ptr is access all Interfaces.C.char; + function Mvwinsnstr (Win : Window; + Line : C_Int; + Column : C_Int; + Str : Char_Ptr; + Len : C_Int) return C_Int; + pragma Import (C, Mvwinsnstr, "mvwinsnstr"); + + Txt : char_array (0 .. Str'Length); + Length : size_t; + begin + To_C (Str, Txt, Length); + if Mvwinsnstr (Win, C_Int (Line), C_Int (Column), + Txt (Txt'First)'Access, C_Int (Len)) + = Curses_Err then + raise Curses_Exception; + end if; + end Insert; +------------------------------------------------------------------------------ + procedure Peek (Win : in Window := Standard_Window; + Str : out String; + Len : in Integer := -1) + is + function Winnstr (Win : Window; + Str : char_array; + Len : C_Int) return C_Int; + pragma Import (C, Winnstr, "winnstr"); + + N : Integer := Len; + Txt : char_array (0 .. Str'Length); + Cnt : Natural; + begin + if N < 0 then + N := Str'Length; + end if; + if N > Str'Length then + raise Constraint_Error; + end if; + Txt (0) := Interfaces.C.char'First; + if Winnstr (Win, Txt, C_Int (N)) = Curses_Err then + raise Curses_Exception; + end if; + To_Ada (Txt, Str, Cnt, True); + if Cnt < Str'Length then + Str ((Str'First + Cnt) .. Str'Last) := (others => ' '); + end if; + end Peek; + + procedure Peek + (Win : in Window := Standard_Window; + Line : in Line_Position; + Column : in Column_Position; + Str : out String; + Len : in Integer := -1) + is + begin + Move_Cursor (Win, Line, Column); + Peek (Win, Str, Len); + end Peek; +------------------------------------------------------------------------------ + procedure Peek + (Win : in Window := Standard_Window; + Str : out Attributed_String; + Len : in Integer := -1) + is + type Chtype_Ptr is access all Attributed_Character; + function Winchnstr (Win : Window; + Str : Chtype_Ptr; + Len : C_Int) return C_Int; + pragma Import (C, Winchnstr, "winchnstr"); + + N : Integer := Len; + Txt : chtype_array (0 .. Str'Length); + Cnt : Natural := 0; + begin + if N < 0 then + N := Str'Length; + end if; + if N > Str'Length then + raise Constraint_Error; + end if; + if Winchnstr (Win, Txt (Txt'First)'Access, C_Int (N)) = Curses_Err then + raise Curses_Exception; + end if; + for To in Str'Range loop + exit when Txt (size_t (Cnt)) = Default_Character; + Str (To) := Txt (size_t (Cnt)); + Cnt := Cnt + 1; + end loop; + if Cnt < Str'Length then + Str ((Str'First + Cnt) .. Str'Last) := + (others => (Ch => ' ', + Color => Color_Pair'First, + Attr => Normal_Video)); + end if; + end Peek; + + procedure Peek + (Win : in Window := Standard_Window; + Line : in Line_Position; + Column : in Column_Position; + Str : out Attributed_String; + Len : in Integer := -1) + is + begin + Move_Cursor (Win, Line, Column); + Peek (Win, Str, Len); + end Peek; +------------------------------------------------------------------------------ + procedure Get (Win : in Window := Standard_Window; + Str : out String; + Len : in Integer := -1) + is + function Wgetnstr (Win : Window; + Str : char_array; + Len : C_Int) return C_Int; + pragma Import (C, Wgetnstr, "wgetnstr"); + + N : Integer := Len; + Txt : char_array (0 .. Str'Length); + Cnt : Natural; + begin + if N < 0 then + N := Str'Length; + end if; + if N > Str'Length then + raise Constraint_Error; + end if; + Txt (0) := Interfaces.C.char'First; + if Wgetnstr (Win, Txt, C_Int (N)) = Curses_Err then + raise Curses_Exception; + end if; + To_Ada (Txt, Str, Cnt, True); + if Cnt < Str'Length then + Str ((Str'First + Cnt) .. Str'Last) := (others => ' '); + end if; + end Get; + + procedure Get + (Win : in Window := Standard_Window; + Line : in Line_Position; + Column : in Column_Position; + Str : out String; + Len : in Integer := -1) + is + begin + Move_Cursor (Win, Line, Column); + Get (Win, Str, Len); + end Get; +------------------------------------------------------------------------------ + procedure Init_Soft_Label_Keys + (Format : in Soft_Label_Key_Format := Three_Two_Three) + is + function Slk_Init (Fmt : C_Int) return C_Int; + pragma Import (C, Slk_Init, "slk_init"); + begin + if Slk_Init (Soft_Label_Key_Format'Pos (Format)) = Curses_Err then + raise Curses_Exception; + end if; + end Init_Soft_Label_Keys; + + procedure Set_Soft_Label_Key (Label : in Label_Number; + Text : in String; + Fmt : in Label_Justification := Left) + is + type Char_Ptr is access all Interfaces.C.char; + function Slk_Set (Label : C_Int; + Txt : Char_Ptr; + Fmt : C_Int) return C_Int; + pragma Import (C, Slk_Set, "slk_set"); + + Txt : char_array (0 .. Text'Length); + Len : size_t; + begin + To_C (Text, Txt, Len); + if Slk_Set (C_Int (Label), + Txt (Txt'First)'Access, + C_Int (Label_Justification'Pos (Fmt))) + = Curses_Err then + raise Curses_Exception; + end if; + end Set_Soft_Label_Key; + + procedure Refresh_Soft_Label_Keys + is + function Slk_Refresh return C_Int; + pragma Import (C, Slk_Refresh, "slk_refresh"); + begin + if Slk_Refresh = Curses_Err then + raise Curses_Exception; + end if; + end Refresh_Soft_Label_Keys; + + procedure Refresh_Soft_Label_Keys_Without_Update + is + function Slk_Noutrefresh return C_Int; + pragma Import (C, Slk_Noutrefresh, "slk_noutrefresh"); + begin + if Slk_Noutrefresh = Curses_Err then + raise Curses_Exception; + end if; + end Refresh_Soft_Label_Keys_Without_Update; + + procedure Get_Soft_Label_Key (Label : in Label_Number; + Text : out String) + is + function Slk_Label (Label : C_Int) return chars_ptr; + pragma Import (C, Slk_Label, "slk_label"); + begin + Fill_String (Slk_Label (C_Int (Label)), Text); + end Get_Soft_Label_Key; + + function Get_Soft_Label_Key (Label : in Label_Number) return String + is + function Slk_Label (Label : C_Int) return chars_ptr; + pragma Import (C, Slk_Label, "slk_label"); + begin + return Fill_String (Slk_Label (C_Int (Label))); + end Get_Soft_Label_Key; + + procedure Clear_Soft_Label_Keys + is + function Slk_Clear return C_Int; + pragma Import (C, Slk_Clear, "slk_clear"); + begin + if Slk_Clear = Curses_Err then + raise Curses_Exception; + end if; + end Clear_Soft_Label_Keys; + + procedure Restore_Soft_Label_Keys + is + function Slk_Restore return C_Int; + pragma Import (C, Slk_Restore, "slk_restore"); + begin + if Slk_Restore = Curses_Err then + raise Curses_Exception; + end if; + end Restore_Soft_Label_Keys; + + procedure Touch_Soft_Label_Keys + is + function Slk_Touch return C_Int; + pragma Import (C, Slk_Touch, "slk_touch"); + begin + if Slk_Touch = Curses_Err then + raise Curses_Exception; + end if; + end Touch_Soft_Label_Keys; + + procedure Switch_Soft_Label_Key_Attributes + (Attr : in Character_Attribute_Set; + On : in Boolean := True) + is + function Slk_Attron (Ch : C_Chtype) return C_Int; + pragma Import (C, Slk_Attron, "slk_attron"); + function Slk_Attroff (Ch : C_Chtype) return C_Int; + pragma Import (C, Slk_Attroff, "slk_attroff"); + + Err : C_Int; + Ch : constant Attributed_Character := (Ch => Character'First, + Attr => Attr, + Color => Color_Pair'First); + begin + if On then + Err := Slk_Attron (AttrChar_To_Chtype (Ch)); + else + Err := Slk_Attroff (AttrChar_To_Chtype (Ch)); + end if; + if Err = Curses_Err then + raise Curses_Exception; + end if; + end Switch_Soft_Label_Key_Attributes; + + procedure Set_Soft_Label_Key_Attributes + (Attr : in Character_Attribute_Set := Normal_Video; + Color : in Color_Pair := Color_Pair'First) + is + function Slk_Attrset (Ch : C_Chtype) return C_Int; + pragma Import (C, Slk_Attrset, "slk_attrset"); + + Ch : constant Attributed_Character := (Ch => Character'First, + Attr => Attr, + Color => Color); + begin + if Slk_Attrset (AttrChar_To_Chtype (Ch)) = Curses_Err then + raise Curses_Exception; + end if; + end Set_Soft_Label_Key_Attributes; + + function Get_Soft_Label_Key_Attributes return Character_Attribute_Set + is + function Slk_Attr return C_Chtype; + pragma Import (C, Slk_Attr, "slk_attr"); + + Attr : constant C_Chtype := Slk_Attr; + begin + return Chtype_To_AttrChar (Attr).Attr; + end Get_Soft_Label_Key_Attributes; + + function Get_Soft_Label_Key_Attributes return Color_Pair + is + function Slk_Attr return C_Chtype; + pragma Import (C, Slk_Attr, "slk_attr"); + + Attr : constant C_Chtype := Slk_Attr; + begin + return Chtype_To_AttrChar (Attr).Color; + end Get_Soft_Label_Key_Attributes; + + procedure Set_Soft_Label_Key_Color (Pair : in Color_Pair) + is + function Slk_Color (Color : in C_Short) return C_Int; + pragma Import (C, Slk_Color, "slk_color"); + begin + if Slk_Color (C_Short (Pair)) = Curses_Err then + raise Curses_Exception; + end if; + end Set_Soft_Label_Key_Color; + +------------------------------------------------------------------------------ + procedure Enable_Key (Key : in Special_Key_Code; + Enable : in Boolean := True) + is + function Keyok (Keycode : C_Int; + On_Off : Curses_Bool) return C_Int; + pragma Import (C, Keyok, "keyok"); + begin + if Keyok (C_Int (Key), Curses_Bool (Boolean'Pos (Enable))) + = Curses_Err then + raise Curses_Exception; + end if; + end Enable_Key; +------------------------------------------------------------------------------ + procedure Define_Key (Definition : in String; + Key : in Special_Key_Code) + is + type Char_Ptr is access all Interfaces.C.char; + function Defkey (Def : Char_Ptr; + Key : C_Int) return C_Int; + pragma Import (C, Defkey, "define_key"); + + Txt : char_array (0 .. Definition'Length); + Length : size_t; + begin + To_C (Definition, Txt, Length); + if Defkey (Txt (Txt'First)'Access, C_Int (Key)) = Curses_Err then + raise Curses_Exception; + end if; + end Define_Key; +------------------------------------------------------------------------------ + procedure Un_Control (Ch : in Attributed_Character; + Str : out String) + is + function Unctrl (Ch : C_Chtype) return chars_ptr; + pragma Import (C, Unctrl, "unctrl"); + begin + Fill_String (Unctrl (AttrChar_To_Chtype (Ch)), Str); + end Un_Control; + + function Un_Control (Ch : in Attributed_Character) return String + is + function Unctrl (Ch : C_Chtype) return chars_ptr; + pragma Import (C, Unctrl, "unctrl"); + begin + return Fill_String (Unctrl (AttrChar_To_Chtype (Ch))); + end Un_Control; + + procedure Delay_Output (Msecs : in Natural) + is + function Delayoutput (Msecs : C_Int) return C_Int; + pragma Import (C, Delayoutput, "delay_output"); + begin + if Delayoutput (C_Int (Msecs)) = Curses_Err then + raise Curses_Exception; + end if; + end Delay_Output; + + procedure Flush_Input + is + function Flushinp return C_Int; + pragma Import (C, Flushinp, "flushinp"); + begin + if Flushinp = Curses_Err then -- docu says that never happens, but... + raise Curses_Exception; + end if; + end Flush_Input; +------------------------------------------------------------------------------ + function Baudrate return Natural + is + function Baud return C_Int; + pragma Import (C, Baud, "baudrate"); + begin + return Natural (Baud); + end Baudrate; + + function Erase_Character return Character + is + function Erasechar return C_Int; + pragma Import (C, Erasechar, "erasechar"); + begin + return Character'Val (Erasechar); + end Erase_Character; + + function Kill_Character return Character + is + function Killchar return C_Int; + pragma Import (C, Killchar, "killchar"); + begin + return Character'Val (Killchar); + end Kill_Character; + + function Has_Insert_Character return Boolean + is + function Has_Ic return Curses_Bool; + pragma Import (C, Has_Ic, "has_ic"); + begin + if Has_Ic = Curses_Bool_False then + return False; + else + return True; + end if; + end Has_Insert_Character; + + function Has_Insert_Line return Boolean + is + function Has_Il return Curses_Bool; + pragma Import (C, Has_Il, "has_il"); + begin + if Has_Il = Curses_Bool_False then + return False; + else + return True; + end if; + end Has_Insert_Line; + + function Supported_Attributes return Character_Attribute_Set + is + function Termattrs return C_Chtype; + pragma Import (C, Termattrs, "termattrs"); + + Ch : constant Attributed_Character := Chtype_To_AttrChar (Termattrs); + begin + return Ch.Attr; + end Supported_Attributes; + + procedure Long_Name (Name : out String) + is + function Longname return chars_ptr; + pragma Import (C, Longname, "longname"); + begin + Fill_String (Longname, Name); + end Long_Name; + + function Long_Name return String + is + function Longname return chars_ptr; + pragma Import (C, Longname, "longname"); + begin + return Fill_String (Longname); + end Long_Name; + + procedure Terminal_Name (Name : out String) + is + function Termname return chars_ptr; + pragma Import (C, Termname, "termname"); + begin + Fill_String (Termname, Name); + end Terminal_Name; + + function Terminal_Name return String + is + function Termname return chars_ptr; + pragma Import (C, Termname, "termname"); + begin + return Fill_String (Termname); + end Terminal_Name; +------------------------------------------------------------------------------ + procedure Init_Pair (Pair : in Redefinable_Color_Pair; + Fore : in Color_Number; + Back : in Color_Number) + is + function Initpair (Pair : C_Short; + Fore : C_Short; + Back : C_Short) return C_Int; + pragma Import (C, Initpair, "init_pair"); + begin + if Integer (Pair) >= Number_Of_Color_Pairs then + raise Constraint_Error; + end if; + if Integer (Fore) >= Number_Of_Colors or else + Integer (Back) >= Number_Of_Colors then raise Constraint_Error; + end if; + if Initpair (C_Short (Pair), C_Short (Fore), C_Short (Back)) + = Curses_Err then + raise Curses_Exception; + end if; + end Init_Pair; + + procedure Pair_Content (Pair : in Color_Pair; + Fore : out Color_Number; + Back : out Color_Number) + is + type C_Short_Access is access all C_Short; + function Paircontent (Pair : C_Short; + Fp : C_Short_Access; + Bp : C_Short_Access) return C_Int; + pragma Import (C, Paircontent, "pair_content"); + + F, B : aliased C_Short; + begin + if Paircontent (C_Short (Pair), F'Access, B'Access) = Curses_Err then + raise Curses_Exception; + else + Fore := Color_Number (F); + Back := Color_Number (B); + end if; + end Pair_Content; + + function Has_Colors return Boolean + is + function Hascolors return Curses_Bool; + pragma Import (C, Hascolors, "has_colors"); + begin + if Hascolors = Curses_Bool_False then + return False; + else + return True; + end if; + end Has_Colors; + + procedure Init_Color (Color : in Color_Number; + Red : in RGB_Value; + Green : in RGB_Value; + Blue : in RGB_Value) + is + function Initcolor (Col : C_Short; + Red : C_Short; + Green : C_Short; + Blue : C_Short) return C_Int; + pragma Import (C, Initcolor, "init_color"); + begin + if Initcolor (C_Short (Color), C_Short (Red), C_Short (Green), + C_Short (Blue)) = Curses_Err then + raise Curses_Exception; + end if; + end Init_Color; + + function Can_Change_Color return Boolean + is + function Canchangecolor return Curses_Bool; + pragma Import (C, Canchangecolor, "can_change_color"); + begin + if Canchangecolor = Curses_Bool_False then + return False; + else + return True; + end if; + end Can_Change_Color; + + procedure Color_Content (Color : in Color_Number; + Red : out RGB_Value; + Green : out RGB_Value; + Blue : out RGB_Value) + is + type C_Short_Access is access all C_Short; + + function Colorcontent (Color : C_Short; R, G, B : C_Short_Access) + return C_Int; + pragma Import (C, Colorcontent, "color_content"); + + R, G, B : aliased C_Short; + begin + if Colorcontent (C_Short (Color), R'Access, G'Access, B'Access) = + Curses_Err then + raise Curses_Exception; + else + Red := RGB_Value (R); + Green := RGB_Value (G); + Blue := RGB_Value (B); + end if; + end Color_Content; + +------------------------------------------------------------------------------ + procedure Save_Curses_Mode (Mode : in Curses_Mode) + is + function Def_Prog_Mode return C_Int; + pragma Import (C, Def_Prog_Mode, "def_prog_mode"); + function Def_Shell_Mode return C_Int; + pragma Import (C, Def_Shell_Mode, "def_shell_mode"); + + Err : C_Int; + begin + case Mode is + when Curses => Err := Def_Prog_Mode; + when Shell => Err := Def_Shell_Mode; + end case; + if Err = Curses_Err then + raise Curses_Exception; + end if; + end Save_Curses_Mode; + + procedure Reset_Curses_Mode (Mode : in Curses_Mode) + is + function Reset_Prog_Mode return C_Int; + pragma Import (C, Reset_Prog_Mode, "reset_prog_mode"); + function Reset_Shell_Mode return C_Int; + pragma Import (C, Reset_Shell_Mode, "reset_shell_mode"); + + Err : C_Int; + begin + case Mode is + when Curses => Err := Reset_Prog_Mode; + when Shell => Err := Reset_Shell_Mode; + end case; + if Err = Curses_Err then + raise Curses_Exception; + end if; + end Reset_Curses_Mode; + + procedure Save_Terminal_State + is + function Savetty return C_Int; + pragma Import (C, Savetty, "savetty"); + begin + if Savetty = Curses_Err then + raise Curses_Exception; + end if; + end Save_Terminal_State; + + procedure Reset_Terminal_State + is + function Resetty return C_Int; + pragma Import (C, Resetty, "resetty"); + begin + if Resetty = Curses_Err then + raise Curses_Exception; + end if; + end Reset_Terminal_State; + + procedure Rip_Off_Lines (Lines : in Integer; + Proc : in Stdscr_Init_Proc) + is + function Ripoffline (Lines : C_Int; + Proc : Stdscr_Init_Proc) return C_Int; + pragma Import (C, Ripoffline, "_nc_ripoffline"); + begin + if Ripoffline (C_Int (Lines), Proc) = Curses_Err then + raise Curses_Exception; + end if; + end Rip_Off_Lines; + + procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility) + is + function Curs_Set (Curs : C_Int) return C_Int; + pragma Import (C, Curs_Set, "curs_set"); + + Res : C_Int; + begin + Res := Curs_Set (Cursor_Visibility'Pos (Visibility)); + if Res /= Curses_Err then + Visibility := Cursor_Visibility'Val (Res); + end if; + end Set_Cursor_Visibility; + + procedure Nap_Milli_Seconds (Ms : in Natural) + is + function Napms (Ms : C_Int) return C_Int; + pragma Import (C, Napms, "napms"); + begin + if Napms (C_Int (Ms)) = Curses_Err then + raise Curses_Exception; + end if; + end Nap_Milli_Seconds; +------------------------------------------------------------------------------ + + function Standard_Window return Window + is + Stdscr : Window; + pragma Import (C, Stdscr, "stdscr"); + begin + return Stdscr; + end Standard_Window; + + function Lines return Line_Count + is + C_Lines : C_Int; + pragma Import (C, C_Lines, "LINES"); + begin + return Line_Count (C_Lines); + end Lines; + + function Columns return Column_Count + is + C_Columns : C_Int; + pragma Import (C, C_Columns, "COLS"); + begin + return Column_Count (C_Columns); + end Columns; + + function Tab_Size return Natural + is + C_Tab_Size : C_Int; + pragma Import (C, C_Tab_Size, "TABSIZE"); + begin + return Natural (C_Tab_Size); + end Tab_Size; + + function Number_Of_Colors return Natural + is + C_Number_Of_Colors : C_Int; + pragma Import (C, C_Number_Of_Colors, "COLORS"); + begin + return Natural (C_Number_Of_Colors); + end Number_Of_Colors; + + function Number_Of_Color_Pairs return Natural + is + C_Number_Of_Color_Pairs : C_Int; + pragma Import (C, C_Number_Of_Color_Pairs, "COLOR_PAIRS"); + begin + return Natural (C_Number_Of_Color_Pairs); + end Number_Of_Color_Pairs; +------------------------------------------------------------------------------ + procedure Transform_Coordinates + (W : in Window := Standard_Window; + Line : in out Line_Position; + Column : in out Column_Position; + Dir : in Transform_Direction := From_Screen) + is + type Int_Access is access all C_Int; + function Transform (W : Window; + Y, X : Int_Access; + Dir : Curses_Bool) return C_Int; + pragma Import (C, Transform, "wmouse_trafo"); + + X : aliased C_Int := C_Int (Column); + Y : aliased C_Int := C_Int (Line); + D : Curses_Bool := Curses_Bool_False; + R : C_Int; + begin + if Dir = To_Screen then + D := 1; + end if; + R := Transform (W, Y'Access, X'Access, D); + if R = Curses_False then + raise Curses_Exception; + else + Line := Line_Position (Y); + Column := Column_Position (X); + end if; + end Transform_Coordinates; + +end Terminal_Interface.Curses; diff --git a/ncurses-5.2/Ada95/src/terminal_interface.ads b/ncurses-5.2/Ada95/src/terminal_interface.ads new file mode 100644 index 0000000..d49747b --- /dev/null +++ b/ncurses-5.2/Ada95/src/terminal_interface.ads @@ -0,0 +1,48 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996 +-- Version Control: +-- $Revision$ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +package Terminal_Interface is + pragma Pure (Terminal_Interface); +-- +-- Everything is in the child units +-- +end Terminal_Interface; + + |