diff options
Diffstat (limited to 'Ada95/src')
60 files changed, 7720 insertions, 0 deletions
diff --git a/Ada95/src/Makefile.in b/Ada95/src/Makefile.in new file mode 100644 index 000000000000..4a599acb8927 --- /dev/null +++ b/Ada95/src/Makefile.in @@ -0,0 +1,304 @@ +############################################################################## +# Copyright (c) 1998-2009,2010 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 +# +# $Id: Makefile.in,v 1.53 2010/11/27 22:14:16 tom Exp $ +# +.SUFFIXES: + +SHELL = /bin/sh +VPATH = @srcdir@ +THIS = Makefile + +MODEL = ../../@DFT_OBJ_SUBDIR@ + +DESTDIR = @DESTDIR@ + +top_srcdir = @top_srcdir@ +srcdir = @srcdir@ +prefix = @prefix@ +exec_prefix = @exec_prefix@ +libdir = ${exec_prefix}/lib + +LIBDIR = $(DESTDIR)$(libdir) +ADA_INCLUDE = $(DESTDIR)@ADA_INCLUDE@ +ADA_OBJECTS = $(DESTDIR)@ADA_OBJECTS@ + +INSTALL = @INSTALL@ +INSTALL_LIB = @INSTALL@ @INSTALL_LIB@ + +AR = @AR@ +ARFLAGS = @ARFLAGS@ +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) + +LIB_NAME = AdaCurses +SONAME = @ADA_SHAREDLIB@ + +GNAT_PROJECT = $(srcdir)/library.gpr + +# build/source are the Ada95 tree +BUILD_DIR = .. +SOURCE_DIR = .. + +BUILD_DIR_LIB = $(BUILD_DIR)/lib +SOURCE_DIR_SRC = $(SOURCE_DIR)/src + +ADAMAKE = @cf_ada_make@ +ADAMAKEFLAGS = \ + -P$(GNAT_PROJECT) \ + -XBUILD_DIR=`cd $(BUILD_DIR);pwd` \ + -XSOURCE_DIR=`cd $(SOURCE_DIR);pwd` \ + -XSOURCE_DIR2=`cd $(srcdir);pwd` \ + -XLIB_NAME=$(LIB_NAME) \ + -XSONAME=$(SONAME) + +CARGS = -cargs $(ADAFLAGS) +LARGS = + +STATIC_LIBNAME = lib$(LIB_NAME).a +SHARED_LIBNAME = $(SONAME) +SHARED_SYMLINK = lib$(LIB_NAME).so + +ALIB = @cf_ada_package@ +ABASE = $(ALIB)-curses +################################################################################ +GENERATED_SOURCES=$(ABASE).ads \ + $(ABASE).adb \ + $(ABASE)-aux.ads \ + $(ABASE)-trace.ads \ + $(ABASE)-menus.ads \ + $(ABASE)-forms.ads \ + $(ABASE)-mouse.ads \ + $(ABASE)-panels.ads \ + $(ABASE)-menus-menu_user_data.ads \ + $(ABASE)-menus-item_user_data.ads \ + $(ABASE)-forms-form_user_data.ads \ + $(ABASE)-forms-field_types.ads \ + $(ABASE)-forms-field_user_data.ads \ + $(ABASE)-panels-user_data.ads +################################################################################ +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 :: $(BUILD_DIR_LIB)/$(STATIC_LIBNAME) + @echo done + +$(ADA_INCLUDE) \ +$(ADA_OBJECTS) \ +$(LIBDIR) \ +$(BUILD_DIR_LIB) : + mkdir -p $@ + +sources : + @echo made $@ + +libs \ +install \ +install.libs :: \ + $(BUILD_DIR_LIB)/$(STATIC_LIBNAME) + @echo made $(STATIC_LIBNAME) + +install \ +install.libs :: \ + $(BUILD_DIR_LIB)/$(STATIC_LIBNAME) \ + $(ADA_OBJECTS) + @$(INSTALL_LIB) \ + $(BUILD_DIR_LIB)/$(STATIC_LIBNAME) \ + $(ADA_OBJECTS) + +uninstall \ +uninstall.libs :: + @rm -f $(ADA_OBJECTS)/$(STATIC_LIBNAME) + +mostlyclean :: + rm -f *.o *.ali b_t*.* *.s $(PROGS) a.out core b_*_test.c *.xr[bs] *.a + +clean :: mostlyclean + rm -f $(ABASE)-trace.adb + +distclean :: clean + rm -f Makefile + +realclean :: distclean + +BASEDEPS=$(ABASE).ads $(ABASE)-aux.ads $(ABASE).adb + +$(ABASE)-trace.adb : $(srcdir)/$(ABASE)-trace.adb_p + rm -f $@ + $(ADAPREP) -DADA_TRACE=@ADA_TRACE@ -DPRAGMA_UNREF=@PRAGMA_UNREF@ $(srcdir)/$(ABASE)-trace.adb_p $@ + +############################################################################### + +@USE_OLD_MAKERULES@$(BUILD_DIR_LIB)/$(STATIC_LIBNAME) :: \ +@USE_OLD_MAKERULES@ $(BUILD_DIR_LIB) \ +@USE_OLD_MAKERULES@ $(LIBOBJS) @cf_generic_objects@ +@USE_OLD_MAKERULES@ $(AR) $(ARFLAGS) $@ $(LIBOBJS) @cf_generic_objects@ + +$(BUILD_DIR)/static-ali : ; mkdir -p $@ +$(BUILD_DIR)/static-obj : ; mkdir -p $@ + +STATIC_DIRS = \ + $(BUILD_DIR_LIB) \ + $(BUILD_DIR)/static-ali \ + $(BUILD_DIR)/static-obj + +@USE_GNAT_PROJECTS@$(BUILD_DIR_LIB)/$(STATIC_LIBNAME) :: \ +@USE_GNAT_PROJECTS@ $(ABASE)-trace.adb \ +@USE_GNAT_PROJECTS@ $(STATIC_DIRS) +@USE_GNAT_PROJECTS@ $(ADAMAKE) $(ADAMAKEFLAGS) -XLIB_KIND=static +@USE_GNAT_PROJECTS@ +@USE_GNAT_PROJECTS@install \ +@USE_GNAT_PROJECTS@install.libs :: \ +@USE_GNAT_PROJECTS@ $(ADA_OBJECTS) +@USE_GNAT_PROJECTS@ $(INSTALL_LIB) \ +@USE_GNAT_PROJECTS@ $(BUILD_DIR)/static-ali/*.ali \ +@USE_GNAT_PROJECTS@ $(ADA_OBJECTS) + +uninstall \ +uninstall.libs :: + @rm -f $(ADA_OBJECTS)/$(STATIC_LIBNAME) + +@USE_GNAT_PROJECTS@uninstall \ +@USE_GNAT_PROJECTS@uninstall.libs :: +@USE_GNAT_PROJECTS@ @$(SHELL) -c 'for name in $(BUILD_DIR)/static-ali/*.ali ; do rm -f $(ADA_OBJECTS)/`basename $$name`; done' + +$(BUILD_DIR)/dynamic-ali : ; mkdir -p $@ +$(BUILD_DIR)/dynamic-obj : ; mkdir -p $@ + +SHARED_DIRS = \ + $(BUILD_DIR_LIB) \ + $(BUILD_DIR)/dynamic-ali \ + $(BUILD_DIR)/dynamic-obj + +@MAKE_ADA_SHAREDLIB@all \ +@MAKE_ADA_SHAREDLIB@$(BUILD_DIR_LIB)/$(SHARED_LIBNAME) :: $(ABASE)-trace.adb $(SHARED_DIRS) +@MAKE_ADA_SHAREDLIB@ $(ADAMAKE) $(ADAMAKEFLAGS) -XLIB_KIND=dynamic + +install \ +install.libs :: $(ADA_INCLUDE) + $(INSTALL_LIB) \ + $(SOURCE_DIR_SRC)/*.ad[sb] \ + $(ADA_INCLUDE) + +install \ +install.libs :: $(ADA_INCLUDE) + $(INSTALL_LIB) \ + $(GENERATED_SOURCES) \ + $(ADA_INCLUDE) + +uninstall \ +uninstall.libs :: + $(SHELL) -c 'for name in $(SOURCE_DIR_SRC)/*.ad[sb] $(GENERATED_SOURCES); do rm -f $(ADA_INCLUDE)/`basename $$name`; done' + +@MAKE_ADA_SHAREDLIB@install \ +@MAKE_ADA_SHAREDLIB@install.libs :: $(ADA_OBJECTS) +@MAKE_ADA_SHAREDLIB@ $(INSTALL_LIB) \ +@MAKE_ADA_SHAREDLIB@ $(BUILD_DIR)/dynamic-ali/* \ +@MAKE_ADA_SHAREDLIB@ $(ADA_OBJECTS) +@MAKE_ADA_SHAREDLIB@ $(INSTALL_LIB) \ +@MAKE_ADA_SHAREDLIB@ $(BUILD_DIR_LIB)/$(SHARED_LIBNAME) \ +@MAKE_ADA_SHAREDLIB@ $(LIBDIR) +@MAKE_ADA_SHAREDLIB@ cd $(LIBDIR) && ln -s $(SHARED_LIBNAME) $(SHARED_SYMLINK) +@MAKE_ADA_SHAREDLIB@ +@MAKE_ADA_SHAREDLIB@uninstall \ +@MAKE_ADA_SHAREDLIB@uninstall.libs :: +@MAKE_ADA_SHAREDLIB@ $(SHELL) -c 'for name in $(BUILD_DIR)/dynamic-ali/* ; do rm -f $(ADA_OBJECTS)/`basename $$name`; done' +@MAKE_ADA_SHAREDLIB@ +@MAKE_ADA_SHAREDLIB@uninstall \ +@MAKE_ADA_SHAREDLIB@uninstall.libs :: +@MAKE_ADA_SHAREDLIB@ rm -f $(LIBDIR)/$(SHARED_SYMLINK) +@MAKE_ADA_SHAREDLIB@ rm -f $(LIBDIR)/$(SHARED_LIBNAME) + +clean :: + rm -rf $(BUILD_DIR)/*-ali + rm -rf $(BUILD_DIR)/*-obj + rm -rf $(BUILD_DIR_LIB) diff --git a/Ada95/src/library.gpr b/Ada95/src/library.gpr new file mode 100644 index 000000000000..62d67702b9c8 --- /dev/null +++ b/Ada95/src/library.gpr @@ -0,0 +1,55 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2010 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. -- +------------------------------------------------------------------------------ +-- $Id: library.gpr,v 1.5 2010/11/27 22:15:04 tom Exp $ +-- http://gcc.gnu.org/onlinedocs/gnat_ugn_unw/Library-Projects.html +-- http://www.adaworld.com/debian/debian-ada-policy.html +project Library is + Build_Dir := External ("BUILD_DIR"); + Source_Dir := External ("SOURCE_DIR"); + Source_Dir2 := External ("SOURCE_DIR2"); + Kind := External ("LIB_KIND"); + for Library_Name use External ("LIB_NAME"); + for Library_Version use External ("SONAME"); + + for Library_Kind use Kind; + for Library_Dir use Build_Dir & "/lib"; + for Object_Dir use Build_Dir & "/" & Kind & "-obj"; + for Library_ALI_Dir use Build_Dir & "/" & Kind & "-ali"; + for Source_Dirs use (Source_Dir & "/src", + Source_Dir2, + Build_Dir & "/src"); + package Compiler is + for Default_Switches ("Ada") use + ("-g", + "-O2", + "-gnatafno", + "-gnatVa", -- All validity checks + "-gnatwa"); -- Activate all optional errors + end Compiler; + +end Library; diff --git a/Ada95/src/modules b/Ada95/src/modules new file mode 100644 index 000000000000..9f5e03038eb6 --- /dev/null +++ b/Ada95/src/modules @@ -0,0 +1,70 @@ +# $Id: modules,v 1.3 2010/06/26 23:33:14 tom Exp $ +############################################################################## +# Copyright (c) 2010 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: Thomas E. Dickey 2010 +# + +# Library objects +# rootname depend-spec depend-body unit +$(ALIB) $(srcdir) none spec +$(ABASE)-aux none $(srcdir) body +$(ABASE) none . body +$(ABASE)-terminfo $(srcdir) $(srcdir) body +$(ABASE)-termcap $(srcdir) $(srcdir) body +$(ABASE)-putwin $(srcdir) $(srcdir) body +$(ABASE)-trace . . body +$(ABASE)-mouse . $(srcdir) body +$(ABASE)-panels . $(srcdir) body +$(ABASE)-menus . $(srcdir) body +$(ABASE)-forms . $(srcdir) body +$(ABASE)-forms-field_types . $(srcdir) body +$(ABASE)-forms-field_types-alpha $(srcdir) $(srcdir) body +$(ABASE)-forms-field_types-alphanumeric $(srcdir) $(srcdir) body +$(ABASE)-forms-field_types-intfield $(srcdir) $(srcdir) body +$(ABASE)-forms-field_types-numeric $(srcdir) $(srcdir) body +$(ABASE)-forms-field_types-regexp $(srcdir) $(srcdir) body +$(ABASE)-forms-field_types-enumeration $(srcdir) $(srcdir) body +$(ABASE)-forms-field_types-ipv4_address $(srcdir) $(srcdir) body +$(ABASE)-forms-field_types-user $(srcdir) $(srcdir) body +$(ABASE)-forms-field_types-user-choice $(srcdir) $(srcdir) body +$(ABASE)-text_io $(srcdir) $(srcdir) body +$(ABASE)-text_io-aux $(srcdir) $(srcdir) body +$(ABASE)-menus-menu_user_data . $(srcdir) body +$(ABASE)-menus-item_user_data . $(srcdir) body +$(ABASE)-forms-form_user_data . $(srcdir) body +$(ABASE)-forms-field_user_data . $(srcdir) body +$(ABASE)-forms-field_types-enumeration-ada $(srcdir) $(srcdir) body +$(ABASE)-panels-user_data . $(srcdir) body +$(ABASE)-text_io-integer_io $(srcdir) $(srcdir) body +$(ABASE)-text_io-float_io $(srcdir) $(srcdir) body +$(ABASE)-text_io-fixed_io $(srcdir) $(srcdir) body +$(ABASE)-text_io-decimal_io $(srcdir) $(srcdir) body +$(ABASE)-text_io-enumeration_io $(srcdir) $(srcdir) body +$(ABASE)-text_io-modular_io $(srcdir) $(srcdir) body +$(ABASE)-text_io-complex_io $(srcdir) $(srcdir) body diff --git a/Ada95/src/terminal_interface-curses-aux.adb b/Ada95/src/terminal_interface-curses-aux.adb new file mode 100644 index 000000000000..9c2f8cd38674 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-aux.adb @@ -0,0 +1,116 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Aux -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.11 $ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +package body Terminal_Interface.Curses.Aux is + -- + -- Some helpers + procedure Fill_String (Cp : 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/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb b/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb new file mode 100644 index 000000000000..8e9d71adaf44 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb @@ -0,0 +1,66 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.Alpha -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2008,2009 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 +-- Version Control: +-- $Revision: 1.10 $ +-- $Date: 2009/12/26 17:38:58 $ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +package body Terminal_Interface.Curses.Forms.Field_Types.Alpha is + + procedure Set_Field_Type (Fld : Field; + Typ : 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/Ada95/src/terminal_interface-curses-forms-field_types-alpha.ads b/Ada95/src/terminal_interface-curses-forms-field_types-alpha.ads new file mode 100644 index 000000000000..7878f73b2b52 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-alpha.ads @@ -0,0 +1,53 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.Alpha -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.12 $ +-- 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 : Field; + Typ : Alpha_Field); + pragma Inline (Set_Field_Type); + +end Terminal_Interface.Curses.Forms.Field_Types.Alpha; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb b/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb new file mode 100644 index 000000000000..4a2f76b83707 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb @@ -0,0 +1,66 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2008,2009 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 +-- Version Control: +-- $Revision: 1.10 $ +-- $Date: 2009/12/26 17:38:58 $ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +package body Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric is + + procedure Set_Field_Type (Fld : Field; + Typ : 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/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.ads b/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.ads new file mode 100644 index 000000000000..c1009ac77adb --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.ads @@ -0,0 +1,54 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.12 $ +-- 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 : Field; + Typ : AlphaNumeric_Field); + pragma Inline (Set_Field_Type); + +end Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb new file mode 100644 index 000000000000..b3eaf447ad88 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb @@ -0,0 +1,81 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998,2004 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 +-- Version Control: +-- $Revision: 1.10 $ +-- $Date: 2004/08/21 21:37:00 $ +-- 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 (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/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.ads b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.ads new file mode 100644 index 000000000000..48fad09c2f25 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.ads @@ -0,0 +1,59 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- +-- -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- +------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer, 1996 +-- Version Control: +-- $Revision: 1.10 $ +-- 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/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb new file mode 100644 index 000000000000..8c7815f6611b --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb @@ -0,0 +1,119 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.Enumeration -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.8 $ +-- 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 : Field; + Typ : 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/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads new file mode 100644 index 000000000000..e6924f6b19f9 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads @@ -0,0 +1,98 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.Enumeration -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.12 $ +-- 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 : Field; + Typ : 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/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb b/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb new file mode 100644 index 000000000000..8b934d08955b --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb @@ -0,0 +1,70 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.IntField -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2008,2009 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 +-- Version Control: +-- $Revision: 1.10 $ +-- $Date: 2009/12/26 17:38:58 $ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +package body Terminal_Interface.Curses.Forms.Field_Types.IntField is + + procedure Set_Field_Type (Fld : Field; + Typ : 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/Ada95/src/terminal_interface-curses-forms-field_types-intfield.ads b/Ada95/src/terminal_interface-curses-forms-field_types-intfield.ads new file mode 100644 index 000000000000..e90f0d06f174 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-intfield.ads @@ -0,0 +1,55 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.IntField -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.12 $ +-- 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 : Field; + Typ : Integer_Field); + pragma Inline (Set_Field_Type); + +end Terminal_Interface.Curses.Forms.Field_Types.IntField; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb b/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb new file mode 100644 index 000000000000..2328f4ed0c0f --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb @@ -0,0 +1,66 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2008,2009 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 +-- Version Control: +-- $Revision: 1.10 $ +-- $Date: 2009/12/26 17:38:58 $ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +package body Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address is + + procedure Set_Field_Type (Fld : Field; + Typ : 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/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.ads b/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.ads new file mode 100644 index 000000000000..af367e7e5ab2 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.ads @@ -0,0 +1,51 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.12 $ +-- 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 : Field; + Typ : Internet_V4_Address_Field); + pragma Inline (Set_Field_Type); + +end Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb b/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb new file mode 100644 index 000000000000..7151bb8b9937 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb @@ -0,0 +1,73 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.Numeric -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2008,2009 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 +-- Version Control: +-- $Revision: 1.11 $ +-- $Date: 2009/12/26 17:38:58 $ +-- 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 + + procedure Set_Field_Type (Fld : Field; + Typ : 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/Ada95/src/terminal_interface-curses-forms-field_types-numeric.ads b/Ada95/src/terminal_interface-curses-forms-field_types-numeric.ads new file mode 100644 index 000000000000..7c6f9fa15cef --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-numeric.ads @@ -0,0 +1,55 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.Numeric -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.12 $ +-- 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 : Field; + Typ : Numeric_Field); + pragma Inline (Set_Field_Type); + +end Terminal_Interface.Curses.Forms.Field_Types.Numeric; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb b/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb new file mode 100644 index 000000000000..f4c7c587ad93 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb @@ -0,0 +1,71 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.RegExp -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.9 $ +-- 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 : Field; + Typ : 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/Ada95/src/terminal_interface-curses-forms-field_types-regexp.ads b/Ada95/src/terminal_interface-curses-forms-field_types-regexp.ads new file mode 100644 index 000000000000..26841382dcb8 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-regexp.ads @@ -0,0 +1,55 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.RegExp -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.12 $ +-- 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 : Field; + Typ : Regular_Expression_Field); + pragma Inline (Set_Field_Type); + +end Terminal_Interface.Curses.Forms.Field_Types.RegExp; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb b/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb new file mode 100644 index 000000000000..f26a42cdca12 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb @@ -0,0 +1,110 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.User.Choice -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2006,2008 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 +-- Version Control: +-- $Revision: 1.15 $ +-- $Date: 2008/07/26 18:48:58 $ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Ada.Unchecked_Conversion; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +package body Terminal_Interface.Curses.Forms.Field_Types.User.Choice is + + pragma Warnings (Off); + function To_Argument_Access is new Ada.Unchecked_Conversion + (System.Address, Argument_Access); + pragma Warnings (On); + + function Generic_Next (Fld : Field; + Usr : System.Address) return C_Int + is + Result : Boolean; + Udf : constant 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 : constant 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/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads b/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads new file mode 100644 index 000000000000..1e69f43a915f --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads @@ -0,0 +1,94 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.User.Choice -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998,2008 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 +-- Version Control: +-- $Revision: 1.12 $ +-- $Date: 2008/07/26 18:49:20 $ +-- 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); + + 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 + 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/Ada95/src/terminal_interface-curses-forms-field_types-user.adb b/Ada95/src/terminal_interface-curses-forms-field_types-user.adb new file mode 100644 index 000000000000..695f91971932 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-user.adb @@ -0,0 +1,133 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.User -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2008,2009 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 +-- Version Control: +-- $Revision: 1.16 $ +-- $Date: 2009/12/26 17:38:58 $ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +with Ada.Unchecked_Conversion; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; + +package body Terminal_Interface.Curses.Forms.Field_Types.User is + + procedure Set_Field_Type (Fld : Field; + Typ : 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 : constant 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; + + pragma Warnings (Off); + function To_Argument_Access is new Ada.Unchecked_Conversion + (System.Address, Argument_Access); + pragma Warnings (On); + + function Generic_Field_Check (Fld : Field; + Usr : System.Address) return C_Int + is + Result : Boolean; + Udf : constant 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 : constant 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/Ada95/src/terminal_interface-curses-forms-field_types-user.ads b/Ada95/src/terminal_interface-curses-forms-field_types-user.ads new file mode 100644 index 000000000000..af45fab49228 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types-user.ads @@ -0,0 +1,95 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types.User -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2008,2009 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 +-- Version Control: +-- $Revision: 1.13 $ +-- $Date: 2009/12/26 17:38:58 $ +-- 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); + 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 : Field; + Typ : 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 + 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/Ada95/src/terminal_interface-curses-forms-field_types.adb b/Ada95/src/terminal_interface-curses-forms-field_types.adb new file mode 100644 index 000000000000..aef5d3c8a389 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_types.adb @@ -0,0 +1,296 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_Types -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2008,2009 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 +-- Version Control: +-- $Revision: 1.21 $ +-- $Date: 2009/12/26 17:38:58 $ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +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 System.Address; + + pragma Warnings (Off); + function To_Argument_Access is new Ada.Unchecked_Conversion + (System.Address, Argument_Access); + pragma Warnings (On); + + 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 : 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 : 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 : constant 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/Ada95/src/terminal_interface-curses-forms-field_user_data.adb b/Ada95/src/terminal_interface-curses-forms-field_user_data.adb new file mode 100644 index 000000000000..96178d8a9349 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-field_user_data.adb @@ -0,0 +1,85 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Field_User_Data -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.13 $ +-- 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 : Field; + Data : 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 : 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 : 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/Ada95/src/terminal_interface-curses-forms-form_user_data.adb b/Ada95/src/terminal_interface-curses-forms-form_user_data.adb new file mode 100644 index 000000000000..84353eb55700 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms-form_user_data.adb @@ -0,0 +1,86 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms.Form_User_Data -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.13 $ +-- 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 : Form; + Data : 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 : 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 : 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/Ada95/src/terminal_interface-curses-forms.adb b/Ada95/src/terminal_interface-curses-forms.adb new file mode 100644 index 000000000000..68825fc3dfbd --- /dev/null +++ b/Ada95/src/terminal_interface-curses-forms.adb @@ -0,0 +1,1161 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Forms -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2008,2009 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 +-- Version Control: +-- $Revision: 1.27 $ +-- $Date: 2009/12/26 17:38:58 $ +-- 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 : 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 : Field; + Just : 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 : Field; + Buffer : Buffer_Number := Buffer_Number'First; + Str : 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 : Field; + Buffer : 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 : Field; + Buffer : 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 : Field; + Status : 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 : Field; + Max : 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 : Field; + Options : 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 : constant 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 : Field; + Options : 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 : constant 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 : Field; + Options : out Field_Option_Set) + is + function Field_Opts (Fld : Field) return C_Int; + pragma Import (C, Field_Opts, "field_opts"); + + Res : constant 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 : Field; + Fore : Character_Attribute_Set := Normal_Video; + Color : 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 : 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 : 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 : Field; + Back : Character_Attribute_Set := Normal_Video; + Color : 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 : 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 : 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 : Field; + Pad : 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 : 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 : 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 : 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 : Form; + Win : 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 : Form; + Win : 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 : 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 : Form; + Proc : 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 : Form; + Proc : 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 : Form; + Proc : 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 : Form; + Proc : 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 : Form; + Flds : 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 > 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 : Field; + Line : Line_Position; + Column : 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 : Form; + Options : 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 : constant 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 : Form; + Options : 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 : constant 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 : Form; + Options : out Form_Option_Set) + is + function Form_Opts (Frm : Form) return C_Int; + pragma Import (C, Form_Opts, "form_opts"); + + Res : constant 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 : Form; + Post : 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 : constant 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 : Form; + Fld : 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 : 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 : Form; + Page : 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 : Field; + New_Page : 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 : 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/Ada95/src/terminal_interface-curses-menus-item_user_data.adb b/Ada95/src/terminal_interface-curses-menus-item_user_data.adb new file mode 100644 index 000000000000..eb06d096dfb2 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-menus-item_user_data.adb @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Menus.Item_User_Data -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.12 $ +-- 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 : Item; + Data : 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 : 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 : 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/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb b/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb new file mode 100644 index 000000000000..7d66a8c052ee --- /dev/null +++ b/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb @@ -0,0 +1,76 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Menus.Menu_User_Data -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.13 $ +-- 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 : Menu; + Data : 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 : 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 : 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/Ada95/src/terminal_interface-curses-menus.adb b/Ada95/src/terminal_interface-curses-menus.adb new file mode 100644 index 000000000000..9fce6de6d9fa --- /dev/null +++ b/Ada95/src/terminal_interface-curses-menus.adb @@ -0,0 +1,1022 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Menus -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2008,2009 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 +-- Version Control: +-- $Revision: 1.27 $ +-- $Date: 2009/12/26 17:38:58 $ +-- 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 : 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 : constant Name_String_Ptr := new Name_String; + Desc_Str : constant 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 : Item; + Value : 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 : Item; + Options : 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 : constant 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 : Item; + Options : 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 : constant 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 : Item; + Options : out Item_Option_Set) + is + function Item_Opts (Itm : Item) return C_Int; + pragma Import (C, Item_Opts, "item_opts"); + + Res : constant 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 : 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 : 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 : 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 : 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 : Menu; + Itm : 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 : Menu; + Line : 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 : Menu; + Post : 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 : Menu; + Options : 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 : constant 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 : Menu; + Options : Menu_Option_Set; + On : 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 : constant 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 : Menu; + Options : out Menu_Option_Set) + is + function Menu_Opts (Men : Menu) return C_Int; + pragma Import (C, Menu_Opts, "menu_opts"); + + Res : constant 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 : Menu; + Win : 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 : Menu; + Win : 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 : 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 : Menu; + Mark : 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 : 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 : Menu; + Fore : Character_Attribute_Set := Normal_Video; + Color : 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 : 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 : 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 : Menu; + Back : Character_Attribute_Set := Normal_Video; + Color : 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 : 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 : 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 : Menu; + Grey : Character_Attribute_Set := Normal_Video; + Color : 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 : 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 : 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 : Menu; + Pad : 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 : 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 : Menu; + Descr : Column_Position := 0; + Row : Line_Position := 0; + Col : 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 : 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 : 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 : Menu; + Lines : Line_Count; + Columns : 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 : 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 : Menu; + Proc : 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 : Menu; + Proc : 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 : Menu; + Proc : 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 : Menu; + Proc : 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 : Menu; + Items : 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 > 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 : constant 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 : 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/Ada95/src/terminal_interface-curses-mouse.adb b/Ada95/src/terminal_interface-curses-mouse.adb new file mode 100644 index 000000000000..9b4032639308 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-mouse.adb @@ -0,0 +1,217 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Mouse -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2008,2009 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 +-- Version Control: +-- $Revision: 1.24 $ +-- $Date: 2009/12/26 17:38:58 $ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +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; + + function Has_Mouse return Boolean + is + function Mouse_Avail return C_Int; + pragma Import (C, Mouse_Avail, "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 : Mouse_Button; + State : 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 : Mouse_Button; + State : 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); + if R = No_Events then + Beep; + end if; + return Old; + end Start_Mouse; + + procedure End_Mouse (Mask : Event_Mask := No_Events) + is + begin + if Mask /= No_Events then + Beep; + end if; + end End_Mouse; + + procedure Dispatch_Event (Mask : Event_Mask; + Button : out Mouse_Button; + State : out Button_State); + + procedure Dispatch_Event (Mask : 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 : 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 : 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/Ada95/src/terminal_interface-curses-panels-user_data.adb b/Ada95/src/terminal_interface-curses-panels-user_data.adb new file mode 100644 index 000000000000..d855f5423c72 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-panels-user_data.adb @@ -0,0 +1,78 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Panels.User_Data -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.12 $ +-- 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 : Panel; + Data : 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 : 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 : 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/Ada95/src/terminal_interface-curses-panels.adb b/Ada95/src/terminal_interface-curses-panels.adb new file mode 100644 index 000000000000..84e29e519c2d --- /dev/null +++ b/Ada95/src/terminal_interface-curses-panels.adb @@ -0,0 +1,165 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Panels -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2004,2009 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 +-- Version Control: +-- $Revision: 1.14 $ +-- $Date: 2009/12/26 17:38:58 $ +-- 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 : 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 : 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 : 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 : 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 : constant Window := Panel_Win (Pan); + begin + if Win = Null_Window then + raise Panel_Exception; + end if; + return Win; + end Get_Window; + + procedure Replace (Pan : Panel; + Win : 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 : Panel; + Line : Line_Position; + Column : 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/Ada95/src/terminal_interface-curses-putwin.adb b/Ada95/src/terminal_interface-curses-putwin.adb new file mode 100644 index 000000000000..986cd6b9bd6c --- /dev/null +++ b/Ada95/src/terminal_interface-curses-putwin.adb @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 +-- Version Control: +-- $Revision: 1.3 $ +-- 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/Ada95/src/terminal_interface-curses-putwin.ads b/Ada95/src/terminal_interface-curses-putwin.ads new file mode 100644 index 000000000000..d302bdcec452 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-putwin.ads @@ -0,0 +1,50 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 +-- Version Control: +-- $Revision: 1.3 $ +-- 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/Ada95/src/terminal_interface-curses-termcap.adb b/Ada95/src/terminal_interface-curses-termcap.adb new file mode 100644 index 000000000000..643865781fd3 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-termcap.adb @@ -0,0 +1,163 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Termcap -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 2000-2006,2009 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 +-- Version Control: +-- $Revision: 1.12 $ +-- $Date: 2009/12/26 17:38:58 $ +-- 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 : constant 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 : 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 : constant t := (others => 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 : constant t := (others => 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/Ada95/src/terminal_interface-curses-termcap.ads b/Ada95/src/terminal_interface-curses-termcap.ads new file mode 100644 index 000000000000..dd01396e8b0b --- /dev/null +++ b/Ada95/src/terminal_interface-curses-termcap.ads @@ -0,0 +1,80 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 +-- Version Control: +-- $Revision: 1.3 $ +-- 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/Ada95/src/terminal_interface-curses-terminfo.adb b/Ada95/src/terminal_interface-curses-terminfo.adb new file mode 100644 index 000000000000..9b3c9d56b330 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-terminfo.adb @@ -0,0 +1,161 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Terminfo -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2006,2009 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 +-- Version Control: +-- $Revision: 1.6 $ +-- $Date: 2009/12/26 17:38:58 $ +-- 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 : chars_ptr) return Boolean; + + function Is_MinusOne_Pointer (P : 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/Ada95/src/terminal_interface-curses-terminfo.ads b/Ada95/src/terminal_interface-curses-terminfo.ads new file mode 100644 index 000000000000..fb39bf1ed6f1 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-terminfo.ads @@ -0,0 +1,81 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 +-- Version Control: +-- $Revision: 1.3 $ +-- 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/Ada95/src/terminal_interface-curses-text_io-aux.adb b/Ada95/src/terminal_interface-curses-text_io-aux.adb new file mode 100644 index 000000000000..50a4e4461baa --- /dev/null +++ b/Ada95/src/terminal_interface-curses-text_io-aux.adb @@ -0,0 +1,128 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Aux -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2006,2009 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 +-- Version Control: +-- $Revision: 1.13 $ +-- $Date: 2009/12/26 17:38:58 $ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +package body Terminal_Interface.Curses.Text_IO.Aux is + + procedure Put_Buf + (Win : Window; + Buf : String; + Width : Field; + Signal : Boolean := True; + Ljust : 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/Ada95/src/terminal_interface-curses-text_io-aux.ads b/Ada95/src/terminal_interface-curses-text_io-aux.ads new file mode 100644 index 000000000000..6b50b3395063 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-text_io-aux.ads @@ -0,0 +1,55 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Aux -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2006,2009 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 +-- Version Control: +-- $Revision: 1.14 $ +-- $Date: 2009/12/26 17:38:58 $ +-- 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 : Window; -- The output window + Buf : String; -- The buffer containing the text + Width : Field; -- The width of the output field + Signal : Boolean := True; -- If true, we raise Layout_Error + Ljust : Boolean := False); -- The Buf is left justified + +end Terminal_Interface.Curses.Text_IO.Aux; diff --git a/Ada95/src/terminal_interface-curses-text_io-complex_io.adb b/Ada95/src/terminal_interface-curses-text_io-complex_io.adb new file mode 100644 index 000000000000..6c2e144eb37c --- /dev/null +++ b/Ada95/src/terminal_interface-curses-text_io-complex_io.adb @@ -0,0 +1,73 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Complex_IO -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.11 $ +-- 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 : Window; + Item : Complex; + Fore : Field := Default_Fore; + Aft : Field := Default_Aft; + Exp : 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 : Complex; + Fore : Field := Default_Fore; + Aft : Field := Default_Aft; + Exp : 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/Ada95/src/terminal_interface-curses-text_io-complex_io.ads b/Ada95/src/terminal_interface-curses-text_io-complex_io.ads new file mode 100644 index 000000000000..e61345895d1e --- /dev/null +++ b/Ada95/src/terminal_interface-curses-text_io-complex_io.ads @@ -0,0 +1,70 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Complex_IO -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.11 $ +-- 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 : Window; + Item : Complex; + Fore : Field := Default_Fore; + Aft : Field := Default_Aft; + Exp : Field := Default_Exp); + + procedure Put + (Item : Complex; + Fore : Field := Default_Fore; + Aft : Field := Default_Aft; + Exp : Field := Default_Exp); + +private + pragma Inline (Put); + +end Terminal_Interface.Curses.Text_IO.Complex_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io-decimal_io.adb b/Ada95/src/terminal_interface-curses-text_io-decimal_io.adb new file mode 100644 index 000000000000..1b1ad8cbf2e8 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-text_io-decimal_io.adb @@ -0,0 +1,75 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Decimal_IO -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.11 $ +-- 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 : Window; + Item : Num; + Fore : Field := Default_Fore; + Aft : Field := Default_Aft; + Exp : 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 : Num; + Fore : Field := Default_Fore; + Aft : Field := Default_Aft; + Exp : 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/Ada95/src/terminal_interface-curses-text_io-decimal_io.ads b/Ada95/src/terminal_interface-curses-text_io-decimal_io.ads new file mode 100644 index 000000000000..1590127451ea --- /dev/null +++ b/Ada95/src/terminal_interface-curses-text_io-decimal_io.ads @@ -0,0 +1,66 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Decimal_IO -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.12 $ +-- 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 : Window; + Item : Num; + Fore : Field := Default_Fore; + Aft : Field := Default_Aft; + Exp : Field := Default_Exp); + + procedure Put + (Item : Num; + Fore : Field := Default_Fore; + Aft : Field := Default_Aft; + Exp : Field := Default_Exp); + +private + pragma Inline (Put); + +end Terminal_Interface.Curses.Text_IO.Decimal_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb b/Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb new file mode 100644 index 000000000000..53f3e55ec837 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb @@ -0,0 +1,80 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Enumeration_IO -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.11 $ +-- 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 : Window; + Item : Enum; + Width : Field := Default_Width; + Set : 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 : Enum; + Width : Field := Default_Width; + Set : 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/Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads b/Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads new file mode 100644 index 000000000000..a981f0ebc579 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads @@ -0,0 +1,63 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Enumeration_IO -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.12 $ +-- 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 : Window; + Item : Enum; + Width : Field := Default_Width; + Set : Type_Set := Default_Setting); + + procedure Put + (Item : Enum; + Width : Field := Default_Width; + Set : Type_Set := Default_Setting); + +private + pragma Inline (Put); + +end Terminal_Interface.Curses.Text_IO.Enumeration_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io-fixed_io.adb b/Ada95/src/terminal_interface-curses-text_io-fixed_io.adb new file mode 100644 index 000000000000..13a34202389e --- /dev/null +++ b/Ada95/src/terminal_interface-curses-text_io-fixed_io.adb @@ -0,0 +1,75 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Fixed_IO -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.11 $ +-- 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 : Window; + Item : Num; + Fore : Field := Default_Fore; + Aft : Field := Default_Aft; + Exp : 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 : Num; + Fore : Field := Default_Fore; + Aft : Field := Default_Aft; + Exp : 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/Ada95/src/terminal_interface-curses-text_io-fixed_io.ads b/Ada95/src/terminal_interface-curses-text_io-fixed_io.ads new file mode 100644 index 000000000000..3c22a01479ca --- /dev/null +++ b/Ada95/src/terminal_interface-curses-text_io-fixed_io.ads @@ -0,0 +1,66 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Fixed_IO -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.12 $ +-- 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 : Window; + Item : Num; + Fore : Field := Default_Fore; + Aft : Field := Default_Aft; + Exp : Field := Default_Exp); + + procedure Put + (Item : Num; + Fore : Field := Default_Fore; + Aft : Field := Default_Aft; + Exp : Field := Default_Exp); + +private + pragma Inline (Put); + +end Terminal_Interface.Curses.Text_IO.Fixed_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io-float_io.adb b/Ada95/src/terminal_interface-curses-text_io-float_io.adb new file mode 100644 index 000000000000..af667b4cd175 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-text_io-float_io.adb @@ -0,0 +1,76 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Float_IO -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.11 $ +-- 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 : Window; + Item : Num; + Fore : Field := Default_Fore; + Aft : Field := Default_Aft; + Exp : 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 : Num; + Fore : Field := Default_Fore; + Aft : Field := Default_Aft; + Exp : 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/Ada95/src/terminal_interface-curses-text_io-float_io.ads b/Ada95/src/terminal_interface-curses-text_io-float_io.ads new file mode 100644 index 000000000000..b0a68d029eb4 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-text_io-float_io.ads @@ -0,0 +1,66 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Float_IO -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.12 $ +-- 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 : Window; + Item : Num; + Fore : Field := Default_Fore; + Aft : Field := Default_Aft; + Exp : Field := Default_Exp); + + procedure Put + (Item : Num; + Fore : Field := Default_Fore; + Aft : Field := Default_Aft; + Exp : Field := Default_Exp); + +private + pragma Inline (Put); + +end Terminal_Interface.Curses.Text_IO.Float_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io-integer_io.adb b/Ada95/src/terminal_interface-curses-text_io-integer_io.adb new file mode 100644 index 000000000000..4d19c42e883f --- /dev/null +++ b/Ada95/src/terminal_interface-curses-text_io-integer_io.adb @@ -0,0 +1,70 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Integer_IO -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.11 $ +-- 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 : Window; + Item : Num; + Width : Field := Default_Width; + Base : 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 : Num; + Width : Field := Default_Width; + Base : 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/Ada95/src/terminal_interface-curses-text_io-integer_io.ads b/Ada95/src/terminal_interface-curses-text_io-integer_io.ads new file mode 100644 index 000000000000..9ffe1e018164 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-text_io-integer_io.ads @@ -0,0 +1,63 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Integer_IO -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.12 $ +-- 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 : Window; + Item : Num; + Width : Field := Default_Width; + Base : Number_Base := Default_Base); + + procedure Put + (Item : Num; + Width : Field := Default_Width; + Base : Number_Base := Default_Base); + +private + pragma Inline (Put); + +end Terminal_Interface.Curses.Text_IO.Integer_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io-modular_io.adb b/Ada95/src/terminal_interface-curses-text_io-modular_io.adb new file mode 100644 index 000000000000..fe8a6d0b1556 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-text_io-modular_io.adb @@ -0,0 +1,70 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Modular_IO -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.11 $ +-- 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 : Window; + Item : Num; + Width : Field := Default_Width; + Base : 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 : Num; + Width : Field := Default_Width; + Base : 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/Ada95/src/terminal_interface-curses-text_io-modular_io.ads b/Ada95/src/terminal_interface-curses-text_io-modular_io.ads new file mode 100644 index 000000000000..68e70e556bf0 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-text_io-modular_io.ads @@ -0,0 +1,63 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO.Modular_IO -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.12 $ +-- 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 : Window; + Item : Num; + Width : Field := Default_Width; + Base : Number_Base := Default_Base); + + procedure Put + (Item : Num; + Width : Field := Default_Width; + Base : Number_Base := Default_Base); + +private + pragma Inline (Put); + +end Terminal_Interface.Curses.Text_IO.Modular_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io.adb b/Ada95/src/terminal_interface-curses-text_io.adb new file mode 100644 index 000000000000..4b29514efbf2 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-text_io.adb @@ -0,0 +1,337 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2006,2009 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 +-- Version Control: +-- $Revision: 1.19 $ +-- $Date: 2009/12/26 17:40:46 $ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +package body Terminal_Interface.Curses.Text_IO is + + Default_Window : Window := Null_Window; + + procedure Set_Window (Win : 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 : 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 : 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 : 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 : Window; Spacing : Positive_Count := 1) + is + P_Size : constant Count := Page_Length (Win); + begin + if not Spacing'Valid 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 : Positive_Count := 1) + is + begin + New_Line (Get_Window, Spacing); + end New_Line; + + procedure New_Page (Win : Window) + is + begin + Clear (Win); + end New_Page; + + procedure New_Page + is + begin + New_Page (Get_Window); + end New_Page; + + procedure Set_Col (Win : Window; To : Positive_Count) + is + Y : Line_Position; + X1 : Column_Position; + X2 : Column_Position; + N : Natural; + begin + if not To'Valid 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 : Positive_Count) + is + begin + Set_Col (Get_Window, To); + end Set_Col; + + procedure Set_Line (Win : Window; To : Positive_Count) + is + Y1 : Line_Position; + Y2 : Line_Position; + X : Column_Position; + N : Natural; + begin + if not To'Valid 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 : Positive_Count) + is + begin + Set_Line (Get_Window, To); + end Set_Line; + + function Col (Win : 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 : 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 : Window; Item : 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 : Character) + is + begin + Put (Get_Window, Item); + end Put; + + -------------------- + -- Strings-Output -- + -------------------- + + procedure Put (Win : Window; Item : 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 : String) + is + begin + Put (Get_Window, Item); + end Put; + + procedure Put_Line + (Win : Window; + Item : String) + is + begin + Put (Win, Item); + New_Line (Win, 1); + end Put_Line; + + procedure Put_Line + (Item : String) + is + begin + Put_Line (Get_Window, Item); + end Put_Line; + +end Terminal_Interface.Curses.Text_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io.ads b/Ada95/src/terminal_interface-curses-text_io.ads new file mode 100644 index 000000000000..9c40329ff4bd --- /dev/null +++ b/Ada95/src/terminal_interface-curses-text_io.ads @@ -0,0 +1,136 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Text_IO -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2003,2009 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 +-- Version Control: +-- $Revision: 1.14 $ +-- 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 : Window); + -- Set Win as the default window + + function Get_Window return Window; + -- Get the current default window + + procedure Flush (Win : 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 : Window) return Count; + function Line_Length return Count; + + function Page_Length (Win : Window) return Count; + function Page_Length return Count; + + ------------------------------------ + -- Column, Line, and Page Control -- + ------------------------------------ + procedure New_Line (Win : Window; Spacing : Positive_Count := 1); + procedure New_Line (Spacing : Positive_Count := 1); + + procedure New_Page (Win : Window); + procedure New_Page; + + procedure Set_Col (Win : Window; To : Positive_Count); + procedure Set_Col (To : Positive_Count); + + procedure Set_Line (Win : Window; To : Positive_Count); + procedure Set_Line (To : Positive_Count); + + function Col (Win : Window) return Positive_Count; + function Col return Positive_Count; + + function Line (Win : Window) return Positive_Count; + function Line return Positive_Count; + + ----------------------- + -- Characters-Output -- + ----------------------- + + procedure Put (Win : Window; Item : Character); + procedure Put (Item : Character); + + -------------------- + -- Strings-Output -- + -------------------- + + procedure Put (Win : Window; Item : String); + procedure Put (Item : String); + + procedure Put_Line + (Win : Window; + Item : String); + + procedure Put_Line + (Item : 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/Ada95/src/terminal_interface-curses-trace.adb_p b/Ada95/src/terminal_interface-curses-trace.adb_p new file mode 100644 index 000000000000..f40d8bf31230 --- /dev/null +++ b/Ada95/src/terminal_interface-curses-trace.adb_p @@ -0,0 +1,97 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Trace -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 2000-2004,2009 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 +-- Version Control: +-- $Revision: 1.6 $ +-- 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 +#if PRAGMA_UNREF + pragma Unreferenced (x); +#end if; + begin + null; + end Trace_On; + + procedure Trace_Put (str : String) is +#if PRAGMA_UNREF + pragma Unreferenced (str); +#end if; + begin + null; + end Trace_Put; +#end if; + +end Terminal_Interface.Curses.Trace; diff --git a/Ada95/src/terminal_interface.ads b/Ada95/src/terminal_interface.ads new file mode 100644 index 000000000000..fdaaf9fe7270 --- /dev/null +++ b/Ada95/src/terminal_interface.ads @@ -0,0 +1,47 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998,2006 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 +-- Version Control: +-- $Revision: 1.14 $ +-- $Date: 2006/06/25 14:30:22 $ +-- Binding Version 01.00 +------------------------------------------------------------------------------ +package Terminal_Interface is + pragma Pure (Terminal_Interface); +-- +-- Everything is in the child units +-- +end Terminal_Interface; |