diff options
Diffstat (limited to 'ncurses-5.3/Ada95/src')
59 files changed, 0 insertions, 10298 deletions
diff --git a/ncurses-5.3/Ada95/src/Makefile.in b/ncurses-5.3/Ada95/src/Makefile.in deleted file mode 100644 index 4667808..0000000 --- a/ncurses-5.3/Ada95/src/Makefile.in +++ /dev/null @@ -1,390 +0,0 @@ -############################################################################## -# 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, 1996 -# Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en -# -# 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@ -ADAPREP = gnatprep -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)-terminfo.ali \ - $(ABASE)-termcap.ali \ - $(ABASE)-putwin.ali \ - $(ABASE)-trace.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)-terminfo.o \ - $(ABASE)-termcap.o \ - $(ABASE)-putwin.o \ - $(ABASE)-trace.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) $(ABASE)-trace.adb - -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)-terminfo.o: \ - $(ABASE)-terminfo.ads \ - $(srcdir)/$(ABASE)-terminfo.adb $(BASEDEPS) - $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-terminfo.adb - - -$(ABASE)-termcap.o: \ - $(ABASE)-termcap.ads \ - $(srcdir)/$(ABASE)-termcap.adb $(BASEDEPS) - $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-termcap.adb - - -$(ABASE)-putwin.o: \ - $(ABASE)-putwin.ads \ - $(srcdir)/$(ABASE)-putwin.adb $(BASEDEPS) - $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-putwin.adb - - -$(ABASE)-trace.adb : $(srcdir)/$(ABASE)-trace.adb_p - rm -f $@ - $(ADAPREP) -DADA_TRACE=@ADA_TRACE@ $(srcdir)/$(ABASE)-trace.adb_p $@ - -$(ABASE)-trace.o: \ - $(ABASE)-trace.ads \ - $(ABASE)-trace.adb $(BASEDEPS) - $(ADA) $(ADAFLAGS) -c -o $@ $(ABASE)-trace.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.3/Ada95/src/terminal_interface-curses-aux.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-aux.adb deleted file mode 100644 index e25e9b0..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-aux.adb +++ /dev/null @@ -1,117 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb deleted file mode 100644 index 6e6b335..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb +++ /dev/null @@ -1,69 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-alpha.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-alpha.ads deleted file mode 100644 index 73e73bd..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-alpha.ads +++ /dev/null @@ -1,54 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb deleted file mode 100644 index f2e15ef..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb +++ /dev/null @@ -1,69 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.ads deleted file mode 100644 index fb46701..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.ads +++ /dev/null @@ -1,55 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb deleted file mode 100644 index 275c1dc..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb +++ /dev/null @@ -1,81 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.ads deleted file mode 100644 index 3a8b59a..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.ads +++ /dev/null @@ -1,60 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb deleted file mode 100644 index a04a150..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb +++ /dev/null @@ -1,120 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads deleted file mode 100644 index 91955f5..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads +++ /dev/null @@ -1,99 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb deleted file mode 100644 index 7a29821..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb +++ /dev/null @@ -1,73 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-intfield.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-intfield.ads deleted file mode 100644 index d473854..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-intfield.ads +++ /dev/null @@ -1,56 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb deleted file mode 100644 index 889a08d..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb +++ /dev/null @@ -1,69 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.ads deleted file mode 100644 index d2db1a3..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.ads +++ /dev/null @@ -1,52 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb deleted file mode 100644 index 3ad26ab..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb +++ /dev/null @@ -1,75 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-numeric.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-numeric.ads deleted file mode 100644 index 3385864..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-numeric.ads +++ /dev/null @@ -1,56 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb deleted file mode 100644 index 48725f5..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb +++ /dev/null @@ -1,72 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-regexp.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-regexp.ads deleted file mode 100644 index 6201807..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-regexp.ads +++ /dev/null @@ -1,56 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb deleted file mode 100644 index 129ea2d..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb +++ /dev/null @@ -1,111 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads deleted file mode 100644 index 4df1954..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads +++ /dev/null @@ -1,97 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-user.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-user.adb deleted file mode 100644 index 9d9285d..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-user.adb +++ /dev/null @@ -1,133 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types-user.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-user.ads deleted file mode 100644 index 9e625fc..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types-user.ads +++ /dev/null @@ -1,98 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_types.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types.adb deleted file mode 100644 index 69c9c98..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_types.adb +++ /dev/null @@ -1,297 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-field_user_data.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_user_data.adb deleted file mode 100644 index 91046a7..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-field_user_data.adb +++ /dev/null @@ -1,86 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms-form_user_data.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-form_user_data.adb deleted file mode 100644 index 2910d24..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms-form_user_data.adb +++ /dev/null @@ -1,87 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-forms.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-forms.adb deleted file mode 100644 index f65984c..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-forms.adb +++ /dev/null @@ -1,1161 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-menus-item_user_data.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-menus-item_user_data.adb deleted file mode 100644 index f5d0bc6..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-menus-item_user_data.adb +++ /dev/null @@ -1,78 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb deleted file mode 100644 index 2405baa..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb +++ /dev/null @@ -1,77 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-menus.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-menus.adb deleted file mode 100644 index 8d854c1..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-menus.adb +++ /dev/null @@ -1,1022 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-mouse.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-mouse.adb deleted file mode 100644 index 29275cb..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-mouse.adb +++ /dev/null @@ -1,215 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-panels-user_data.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-panels-user_data.adb deleted file mode 100644 index 14871c0..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-panels-user_data.adb +++ /dev/null @@ -1,79 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-panels.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-panels.adb deleted file mode 100644 index 03e298c..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-panels.adb +++ /dev/null @@ -1,165 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-putwin.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-putwin.adb deleted file mode 100644 index 22e0ff4..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-putwin.adb +++ /dev/null @@ -1,78 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.PutWin -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control: --- $Revision$ --- Binding Version 01.00 - -with Ada.Streams.Stream_IO.C_Streams; -with Interfaces.C_Streams; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; - -package body Terminal_Interface.Curses.PutWin is - - package ICS renames Interfaces.C_Streams; - package ACS renames Ada.Streams.Stream_IO.C_Streams; - use type C_Int; - - procedure Put_Window (Win : Window; - File : Ada.Streams.Stream_IO.File_Type) is - function putwin (Win : Window; f : ICS.FILEs) return C_Int; - pragma Import (C, putwin, "putwin"); - - R : constant C_Int := putwin (Win, ACS.C_Stream (File)); - begin - if R /= Curses_Ok then - raise Curses_Exception; - end if; - end Put_Window; - - function Get_Window (File : Ada.Streams.Stream_IO.File_Type) - return Window is - function getwin (f : ICS.FILEs) return Window; - pragma Import (C, getwin, "getwin"); - - W : constant Window := getwin (ACS.C_Stream (File)); - begin - if W = Null_Window then - raise Curses_Exception; - else - return W; - end if; - end Get_Window; - -end Terminal_Interface.Curses.PutWin; diff --git a/ncurses-5.3/Ada95/src/terminal_interface-curses-putwin.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-putwin.ads deleted file mode 100644 index 8ffee2d..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-putwin.ads +++ /dev/null @@ -1,51 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.PutWin -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control: --- $Revision$ --- Binding Version 01.00 - -with Ada.Streams.Stream_IO; - -package Terminal_Interface.Curses.PutWin is - - procedure Put_Window (Win : Window; - File : Ada.Streams.Stream_IO.File_Type); - - function Get_Window (File : Ada.Streams.Stream_IO.File_Type) return Window; - -end Terminal_Interface.Curses.PutWin; diff --git a/ncurses-5.3/Ada95/src/terminal_interface-curses-termcap.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-termcap.adb deleted file mode 100644 index be845d5..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-termcap.adb +++ /dev/null @@ -1,164 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Termcap -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control: --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- - -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -with Interfaces.C; use Interfaces.C; -with Interfaces.C.Strings; use Interfaces.C.Strings; - -package body Terminal_Interface.Curses.Termcap is - - function Get_Entry (Name : String) return Boolean - is - function tgetent (name : char_array; val : char_array) - return C_Int; - pragma Import (C, tgetent, "tgetent"); - NameTxt : char_array (0 .. Name'Length); - Length : size_t; - ignored : char_array (0 .. 0) := (0 => nul); - result : C_Int; - begin - To_C (Name, NameTxt, Length); - result := tgetent (char_array (ignored), NameTxt); - if result = -1 then - raise Curses_Exception; - else - return Boolean'Val (result); - end if; - end Get_Entry; - ------------------------------------------------------------------------------- - function Get_Flag (Name : String) return Boolean - is - function tgetflag (id : char_array) return C_Int; - pragma Import (C, tgetflag, "tgetflag"); - Txt : char_array (0 .. Name'Length); - Length : size_t; - begin - To_C (Name, Txt, Length); - if tgetflag (Txt) = 0 then - return False; - else - return True; - end if; - end Get_Flag; - ------------------------------------------------------------------------------- - procedure Get_Number (Name : in String; - Value : out Integer; - Result : out Boolean) - is - function tgetnum (id : char_array) return C_Int; - pragma Import (C, tgetnum, "tgetnum"); - Txt : char_array (0 .. Name'Length); - Length : size_t; - begin - To_C (Name, Txt, Length); - Value := Integer (tgetnum (Txt)); - if Value = -1 then - Result := False; - else - Result := True; - end if; - end Get_Number; - ------------------------------------------------------------------------------- - procedure Get_String (Name : String; - Value : out String; - Result : out Boolean) - is - function tgetstr (id : char_array; - buf : char_array) return chars_ptr; - pragma Import (C, tgetstr, "tgetstr"); - Txt : char_array (0 .. Name'Length); - Length : size_t; - Txt2 : chars_ptr; - type t is new char_array (0 .. 1024); -- does it need to be 1024? - Return_Buffer : t := (0 => nul); - begin - To_C (Name, Txt, Length); - Txt2 := tgetstr (Txt, char_array (Return_Buffer)); - if Txt2 = Null_Ptr then - Result := False; - else - Value := Fill_String (Txt2); - Result := True; - end if; - end Get_String; - - function Get_String (Name : String) return Boolean - is - function tgetstr (Id : char_array; - buf : char_array) return chars_ptr; - pragma Import (C, tgetstr, "tgetstr"); - Txt : char_array (0 .. Name'Length); - Length : size_t; - Txt2 : chars_ptr; - type t is new char_array (0 .. 1024); -- does it need to be 1024? - Phony_Txt : t := (0 => nul); - begin - To_C (Name, Txt, Length); - Txt2 := tgetstr (Txt, char_array (Phony_Txt)); - if Txt2 = Null_Ptr then - return False; - else - return True; - end if; - end Get_String; - ------------------------------------------------------------------------------- - function TGoto (Cap : String; - Col : Column_Position; - Row : Line_Position) return Termcap_String is - function tgoto (cap : char_array; - col : C_Int; - row : C_Int) return chars_ptr; - pragma Import (C, tgoto); - Txt : char_array (0 .. Cap'Length); - Length : size_t; - begin - To_C (Cap, Txt, Length); - return Termcap_String (Fill_String - (tgoto (Txt, C_Int (Col), C_Int (Row)))); - end TGoto; - - -end Terminal_Interface.Curses.Termcap; diff --git a/ncurses-5.3/Ada95/src/terminal_interface-curses-termcap.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-termcap.ads deleted file mode 100644 index 341e581..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-termcap.ads +++ /dev/null @@ -1,81 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Termcap -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control: --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- - -package Terminal_Interface.Curses.Termcap is - pragma Preelaborate (Terminal_Interface.Curses.Termcap); - - -- |===================================================================== - -- | Man page curs_termcap.3x - -- |===================================================================== - -- Not implemented: tputs (see curs_terminfo) - - type Termcap_String is new String; - - -- | - function TGoto (Cap : String; - Col : Column_Position; - Row : Line_Position) return Termcap_String; - -- AKA: tgoto() - - -- | - function Get_Entry (Name : String) return Boolean; - -- AKA: tgetent() - - -- | - function Get_Flag (Name : String) return Boolean; - -- AKA: tgetflag() - - -- | - procedure Get_Number (Name : String; - Value : out Integer; - Result : out Boolean); - -- AKA: tgetnum() - - -- | - procedure Get_String (Name : String; - Value : out String; - Result : out Boolean); - function Get_String (Name : String) return Boolean; - -- Returns True if the string is found. - -- AKA: tgetstr() - -end Terminal_Interface.Curses.Termcap; diff --git a/ncurses-5.3/Ada95/src/terminal_interface-curses-terminfo.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-terminfo.adb deleted file mode 100644 index 004e387..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-terminfo.adb +++ /dev/null @@ -1,162 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Terminfo -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control: --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- - -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 Ada.Unchecked_Conversion; - -package body Terminal_Interface.Curses.Terminfo is - - - function Is_MinusOne_Pointer (P : in chars_ptr) return Boolean; - - function Is_MinusOne_Pointer (P : in chars_ptr) return Boolean is - type Weird_Address is new System.Storage_Elements.Integer_Address; - Invalid_Pointer : constant Weird_Address := -1; - function To_Weird is new Ada.Unchecked_Conversion - (Source => chars_ptr, Target => Weird_Address); - begin - if To_Weird (P) = Invalid_Pointer then - return True; - else - return False; - end if; - end Is_MinusOne_Pointer; - pragma Inline (Is_MinusOne_Pointer); - ------------------------------------------------------------------------------- - function Get_Flag (Name : String) return Boolean - is - function tigetflag (id : char_array) return Curses_Bool; - pragma Import (C, tigetflag); - Txt : char_array (0 .. Name'Length); - Length : size_t; - begin - To_C (Name, Txt, Length); - if tigetflag (Txt) = Curses_Bool (Curses_True) then - return True; - else - return False; - end if; - end Get_Flag; - ------------------------------------------------------------------------------- - procedure Get_String (Name : String; - Value : out Terminfo_String; - Result : out Boolean) - is - function tigetstr (id : char_array) return chars_ptr; - pragma Import (C, tigetstr, "tigetstr"); - Txt : char_array (0 .. Name'Length); - Length : size_t; - Txt2 : chars_ptr; - begin - To_C (Name, Txt, Length); - Txt2 := tigetstr (Txt); - if Txt2 = Null_Ptr then - Result := False; - elsif Is_MinusOne_Pointer (Txt2) then - raise Curses_Exception; - else - Value := Terminfo_String (Fill_String (Txt2)); - Result := True; - end if; - end Get_String; - ------------------------------------------------------------------------------- - function Has_String (Name : String) return Boolean - is - function tigetstr (id : char_array) return chars_ptr; - pragma Import (C, tigetstr, "tigetstr"); - Txt : char_array (0 .. Name'Length); - Length : size_t; - Txt2 : chars_ptr; - begin - To_C (Name, Txt, Length); - Txt2 := tigetstr (Txt); - if Txt2 = Null_Ptr then - return False; - elsif Is_MinusOne_Pointer (Txt2) then - raise Curses_Exception; - else - return True; - end if; - end Has_String; - ------------------------------------------------------------------------------- - function Get_Number (Name : String) return Integer is - function tigetstr (s : char_array) return C_Int; - pragma Import (C, tigetstr); - Txt : char_array (0 .. Name'Length); - Length : size_t; - begin - To_C (Name, Txt, Length); - return Integer (tigetstr (Txt)); - end Get_Number; - ------------------------------------------------------------------------------- - procedure Put_String (Str : Terminfo_String; - affcnt : Natural := 1; - putc : putctype := null) is - function tputs (str : char_array; - affcnt : C_Int; - putc : putctype) return C_Int; - function putp (str : char_array) return C_Int; - pragma Import (C, tputs); - pragma Import (C, putp); - Txt : char_array (0 .. Str'Length); - Length : size_t; - Err : C_Int; - begin - To_C (String (Str), Txt, Length); - if putc = null then - Err := putp (Txt); - else - Err := tputs (Txt, C_Int (affcnt), putc); - end if; - if Err = Curses_Err then - raise Curses_Exception; - end if; - end Put_String; - -end Terminal_Interface.Curses.Terminfo; diff --git a/ncurses-5.3/Ada95/src/terminal_interface-curses-terminfo.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-terminfo.ads deleted file mode 100644 index 3fe5a7a..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-terminfo.ads +++ /dev/null @@ -1,82 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Terminfo -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control: --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- - -with Interfaces.C; - -package Terminal_Interface.Curses.Terminfo is - pragma Preelaborate (Terminal_Interface.Curses.Terminfo); - - -- |===================================================================== - -- | Man page curs_terminfo.3x - -- |===================================================================== - -- Not implemented: setupterm, setterm, set_curterm, del_curterm, - -- restartterm, tparm, putp, vidputs, vidattr, - -- mvcur - - type Terminfo_String is new String; - - -- | - procedure Get_String (Name : String; - Value : out Terminfo_String; - Result : out Boolean); - function Has_String (Name : String) return Boolean; - -- AKA: tigetstr() - - -- | - function Get_Flag (Name : String) return Boolean; - -- AKA: tigetflag() - - -- | - function Get_Number (Name : String) return Integer; - -- AKA: tigetnum() - - type putctype is access function (c : Interfaces.C.int) - return Interfaces.C.int; - pragma Convention (C, putctype); - - -- | - procedure Put_String (Str : Terminfo_String; - affcnt : Natural := 1; - putc : putctype := null); - -- AKA: tputs() - -end Terminal_Interface.Curses.Terminfo; diff --git a/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-aux.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-aux.adb deleted file mode 100644 index eddbc31..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-aux.adb +++ /dev/null @@ -1,129 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-text_io-aux.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-aux.ads deleted file mode 100644 index eaf589e..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-aux.ads +++ /dev/null @@ -1,56 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-text_io-complex_io.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-complex_io.adb deleted file mode 100644 index f418c90..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-complex_io.adb +++ /dev/null @@ -1,74 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-text_io-complex_io.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-complex_io.ads deleted file mode 100644 index 8ef99d5..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-complex_io.ads +++ /dev/null @@ -1,71 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-text_io-decimal_io.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-decimal_io.adb deleted file mode 100644 index 6c3dee5..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-decimal_io.adb +++ /dev/null @@ -1,76 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-text_io-decimal_io.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-decimal_io.ads deleted file mode 100644 index 469da7c..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-decimal_io.ads +++ /dev/null @@ -1,67 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb deleted file mode 100644 index 026b288..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb +++ /dev/null @@ -1,81 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads deleted file mode 100644 index 31829d3..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads +++ /dev/null @@ -1,64 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-text_io-fixed_io.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-fixed_io.adb deleted file mode 100644 index e9ed86d..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-fixed_io.adb +++ /dev/null @@ -1,76 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-text_io-fixed_io.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-fixed_io.ads deleted file mode 100644 index b73b8e6..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-fixed_io.ads +++ /dev/null @@ -1,67 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-text_io-float_io.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-float_io.adb deleted file mode 100644 index 67c1281..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-float_io.adb +++ /dev/null @@ -1,77 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-text_io-float_io.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-float_io.ads deleted file mode 100644 index b98cf36..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-float_io.ads +++ /dev/null @@ -1,67 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-text_io-integer_io.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-integer_io.adb deleted file mode 100644 index c9e7f27..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-integer_io.adb +++ /dev/null @@ -1,71 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-text_io-integer_io.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-integer_io.ads deleted file mode 100644 index b7b1932..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-integer_io.ads +++ /dev/null @@ -1,64 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-text_io-modular_io.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-modular_io.adb deleted file mode 100644 index 48a83a8..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-modular_io.adb +++ /dev/null @@ -1,71 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-text_io-modular_io.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-modular_io.ads deleted file mode 100644 index a9264a8..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io-modular_io.ads +++ /dev/null @@ -1,64 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-text_io.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io.adb deleted file mode 100644 index 64ac2b6..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io.adb +++ /dev/null @@ -1,337 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-text_io.ads b/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io.ads deleted file mode 100644 index ef170b0..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-text_io.ads +++ /dev/null @@ -1,137 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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.3/Ada95/src/terminal_interface-curses-trace.adb_p b/ncurses-5.3/Ada95/src/terminal_interface-curses-trace.adb_p deleted file mode 100644 index 9e8e810..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses-trace.adb_p +++ /dev/null @@ -1,92 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Trace -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control: --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -#if ADA_TRACE then -with Interfaces.C; use Interfaces.C; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -with Ada.Unchecked_Conversion; -#end if; - -package body Terminal_Interface.Curses.Trace is - -#if ADA_TRACE then - type C_TraceType is new C_UInt; - - function TraceAda_To_TraceC is new - Ada.Unchecked_Conversion (Source => Trace_Attribute_Set, - Target => C_TraceType); - - procedure Trace_On (x : Trace_Attribute_Set) is - procedure traceC (y : C_TraceType); - pragma Import (C, traceC, "trace"); - begin - traceC (TraceAda_To_TraceC (x)); - end Trace_On; - - -- 75. (12) A C function that takes a variable number of arguments can - -- correspond to several Ada subprograms, taking various specific - -- numbers and types of parameters. - - procedure Trace_Put (str : String) is - procedure tracef (format : char_array; s : char_array); - pragma Import (C, tracef, "_tracef"); - Txt : char_array (0 .. str'Length); - Length : size_t; - formatstr : constant String := "%s" & ASCII.Nul; - formattxt : char_array (0 .. formatstr'Length); - begin - To_C (formatstr, formattxt, Length); - To_C (str, Txt, Length); - tracef (formattxt, Txt); - end Trace_Put; -#else - procedure Trace_On (x : Trace_Attribute_Set) is - begin - null; - end Trace_On; - - procedure Trace_Put (str : String) is - begin - null; - end Trace_Put; -#end if; - -end Terminal_Interface.Curses.Trace; diff --git a/ncurses-5.3/Ada95/src/terminal_interface-curses.adb b/ncurses-5.3/Ada95/src/terminal_interface-curses.adb deleted file mode 100644 index 359cced..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface-curses.adb +++ /dev/null @@ -1,2561 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- 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 Get_Flag (Win : Window; - Offset : Natural) return Boolean; - - function Get_Flag (Win : Window; - Offset : Natural) return Boolean - is - Res : C_Int; - begin - case Sizeof_bool is - when 1 => Res := C_Int (W_Get_Byte (Win, Offset)); - when 2 => Res := C_Int (W_Get_Short (Win, Offset)); - when 4 => Res := C_Int (W_Get_Int (Win, Offset)); - when others => raise Curses_Exception; - end case; - - case Res is - when 0 => return False; - when others => return True; - end case; - end Get_Flag; - ------------------------------------------------------------------------------- - 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 - function Waddnstr (Win : Window; - Str : char_array; - 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, 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 - function Waddchnstr (Win : Window; - Str : chtype_array; - 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, - 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 Standout (Win : Window := Standard_Window; - On : Boolean := True) - is - function wstandout (Win : Window) return C_Int; - pragma Import (C, wstandout, "wstandout"); - function wstandend (Win : Window) return C_Int; - pragma Import (C, wstandend, "wstandend"); - - Err : C_Int; - begin - if On then - Err := wstandout (Win); - else - Err := wstandend (Win); - end if; - if Err = Curses_Err then - raise Curses_Exception; - end if; - end Standout; - - 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; - - function Get_KeyPad_Mode (Win : in Window := Standard_Window) - return Boolean - is - begin - return Get_Flag (Win, Offset_use_keypad); - end Get_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 - begin - return Get_Flag (Win, Offset_scroll); - 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 - function Winsnstr (Win : Window; - Str : char_array; - 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, 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 - function Mvwinsnstr (Win : Window; - Line : C_Int; - Column : C_Int; - Str : char_array; - 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, 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 - function Winchnstr (Win : Window; - Str : chtype_array; -- out - Len : C_Int) return C_Int; - pragma Import (C, Winchnstr, "winchnstr"); - - N : Integer := Len; - Txt : chtype_array (0 .. Str'Length) := (0 => Default_Character); - 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, 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 - function Slk_Set (Label : C_Int; - Txt : char_array; - 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, - 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 - function Defkey (Def : char_array; - 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, 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; ------------------------------------------------------------------------------- - procedure Use_Default_Colors is - function C_Use_Default_Colors return C_Int; - pragma Import (C, C_Use_Default_Colors, "use_default_colors"); - Err : constant C_Int := C_Use_Default_Colors; - begin - if Err = Curses_Err then - raise Curses_Exception; - end if; - end Use_Default_Colors; - - procedure Assume_Default_Colors (Fore : Color_Number := Default_Color; - Back : Color_Number := Default_Color) - is - function C_Assume_Default_Colors (Fore : C_Int; - Back : C_Int) return C_Int; - pragma Import (C, C_Assume_Default_Colors, "assume_default_colors"); - - Err : constant C_Int := C_Assume_Default_Colors (C_Int (Fore), - C_Int (Black)); - begin - if Err = Curses_Err then - raise Curses_Exception; - end if; - end Assume_Default_Colors; ------------------------------------------------------------------------------- - function Curses_Version return String - is - function curses_versionC return chars_ptr; - pragma Import (C, curses_versionC, "curses_version"); - Result : constant chars_ptr := curses_versionC; - begin - return Fill_String (Result); - end Curses_Version; ------------------------------------------------------------------------------- - function Use_Extended_Names (Enable : Boolean) return Boolean - is - function use_extended_namesC (e : Curses_Bool) return C_Int; - pragma Import (C, use_extended_namesC, "use_extended_names"); - - Res : constant C_Int := - use_extended_namesC (Curses_Bool (Boolean'Pos (Enable))); - begin - if Res = C_Int (Curses_Bool_False) then - return False; - else - return True; - end if; - end Use_Extended_Names; ------------------------------------------------------------------------------- - procedure Screen_Dump_To_File (Filename : in String) - is - function scr_dump (f : char_array) return C_Int; - pragma Import (C, scr_dump, "scr_dump"); - Txt : char_array (0 .. Filename'Length); - Length : size_t; - begin - To_C (Filename, Txt, Length); - if Curses_Err = scr_dump (Txt) then - raise Curses_Exception; - end if; - end Screen_Dump_To_File; - - procedure Screen_Restore_From_File (Filename : in String) - is - function scr_restore (f : char_array) return C_Int; - pragma Import (C, scr_restore, "scr_restore"); - Txt : char_array (0 .. Filename'Length); - Length : size_t; - begin - To_C (Filename, Txt, Length); - if Curses_Err = scr_restore (Txt) then - raise Curses_Exception; - end if; - end Screen_Restore_From_File; - - procedure Screen_Init_From_File (Filename : in String) - is - function scr_init (f : char_array) return C_Int; - pragma Import (C, scr_init, "scr_init"); - Txt : char_array (0 .. Filename'Length); - Length : size_t; - begin - To_C (Filename, Txt, Length); - if Curses_Err = scr_init (Txt) then - raise Curses_Exception; - end if; - end Screen_Init_From_File; - - procedure Screen_Set_File (Filename : in String) - is - function scr_set (f : char_array) return C_Int; - pragma Import (C, scr_set, "scr_set"); - Txt : char_array (0 .. Filename'Length); - Length : size_t; - begin - To_C (Filename, Txt, Length); - if Curses_Err = scr_set (Txt) then - raise Curses_Exception; - end if; - end Screen_Set_File; ------------------------------------------------------------------------------- - procedure Resize (Win : Window := Standard_Window; - Number_Of_Lines : Line_Count; - Number_Of_Columns : Column_Count) is - function wresize (win : Window; - lines : C_Int; - columns : C_Int) return C_Int; - pragma Import (C, wresize); - begin - if wresize (Win, - C_Int (Number_Of_Lines), - C_Int (Number_Of_Columns)) = Curses_Err then - raise Curses_Exception; - end if; - end Resize; ------------------------------------------------------------------------------- - -end Terminal_Interface.Curses; - diff --git a/ncurses-5.3/Ada95/src/terminal_interface.ads b/ncurses-5.3/Ada95/src/terminal_interface.ads deleted file mode 100644 index 6953421..0000000 --- a/ncurses-5.3/Ada95/src/terminal_interface.ads +++ /dev/null @@ -1,49 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control: --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package Terminal_Interface is - pragma Pure (Terminal_Interface); --- --- Everything is in the child units --- -end Terminal_Interface; - - |