Base version of ncurses-5.7 library
diff --git a/Ada95/Makefile.in b/Ada95/Makefile.in
new file mode 100644
index 0000000..b1743cf
--- /dev/null
+++ b/Ada95/Makefile.in
@@ -0,0 +1,67 @@
+##############################################################################
+# 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.15 $
+#
+SHELL = /bin/sh
+THIS = Makefile
+
+SUBDIRS = @ADA_SUBDIRS@
+
+CF_MFLAGS = @cf_cv_makeflags@
+@SET_MAKE@
+
+all \
+libs \
+sources \
+install \
+install.libs \
+uninstall \
+uninstall.libs ::
+ for d in $(SUBDIRS); do \
+ (cd $$d ; $(MAKE) $(CF_MFLAGS) $@) ;\
+ done
+
+clean \
+mostlyclean ::
+ for d in $(SUBDIRS); do \
+ (cd $$d ; $(MAKE) $(CF_MFLAGS) $@) ;\
+ done
+
+distclean \
+realclean ::
+ for d in $(SUBDIRS); do \
+ (cd $$d ; $(MAKE) $(CF_MFLAGS) $@) ;\
+ done
+ rm -f Makefile
+
+install.data :
+ @
diff --git a/Ada95/README b/Ada95/README
new file mode 100644
index 0000000..be84259
--- /dev/null
+++ b/Ada95/README
@@ -0,0 +1,33 @@
+-------------------------------------------------------------------------------
+-- 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
+
+The documentation is provided in HTML format in the ./html
+subdirectory. The main document is named index.html
+
diff --git a/Ada95/TODO b/Ada95/TODO
new file mode 100644
index 0000000..f5c8acd
--- /dev/null
+++ b/Ada95/TODO
@@ -0,0 +1,55 @@
+-------------------------------------------------------------------------------
+-- Copyright (c) 1998-1999,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. --
+-------------------------------------------------------------------------------
+-- $Id: TODO,v 1.5 2006/04/22 22:23:21 tom Exp $
+-------------------------------------------------------------------------------
+
+-- Intensive testing
+ Perhaps the delivery of the Beta will help a bit.
+
+-- Documentation
+ Like most WEB pages: under continuous construction
+
+-- Style cleanup
+
+-- Alternate functions for procedures with out params
+ Comfort purpose
+
+-- Sample program
+ Under continuous construction (and it's not a WEB page!!!)
+
+-- Make the binding objects a shared library
+ They are rather large, so it would make sense, otherwise Ada95
+ would look too large, although the generated code is as compact
+ as C or C++. I'll wait a bit until the GNAT people provide some
+ better support to construct shared libraries.
+
+-- Think about more inlining
+
+-- Check for memory leaks.
+ Oh I would like it so much if the GNAT guys would put an optional
+ GC into their system.
diff --git a/Ada95/gen/Makefile.in b/Ada95/gen/Makefile.in
new file mode 100644
index 0000000..b7e3bec
--- /dev/null
+++ b/Ada95/gen/Makefile.in
@@ -0,0 +1,474 @@
+##############################################################################
+# Copyright (c) 1998-2007,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
+#
+# $Id: Makefile.in,v 1.61 2008/10/04 22:58:31 tom Exp $
+#
+.SUFFIXES:
+
+SHELL = /bin/sh
+THIS = Makefile
+
+x = @PROG_EXT@
+
+top_srcdir = @top_srcdir@
+DESTDIR = @DESTDIR@
+srcdir = @srcdir@
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+bindir = @bindir@
+
+ADA_INCLUDE = $(DESTDIR)@ADA_INCLUDE@
+ADA_OBJECTS = $(DESTDIR)@ADA_OBJECTS@
+
+INSTALL = @INSTALL@
+INSTALL_PROG = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+AWK = @AWK@
+LN_S = @LN_S@
+
+CC = @CC@
+HOST_CC = @BUILD_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@)
+
+REL_VERSION = @cf_cv_rel_version@
+ABI_VERSION = @cf_cv_abi_version@
+LOCAL_LIBDIR = @top_builddir@/lib
+
+LINK = $(HOST_CC)
+LD_FLAGS = @LD_MODEL@ $(LOCAL_LIBS) @LDFLAGS@ @LIBS@ @LOCAL_LDFLAGS2@ $(LDFLAGS) @TINFO_ARGS2@
+
+RANLIB = @RANLIB@
+
+M4 = m4
+M4FLAGS = -DNCURSES_EXT_FUNCS=@NCURSES_EXT_FUNCS@
+
+ADACURSES_CONFIG = adacurses-config
+
+WRAPPER = sh $(top_srcdir)/misc/shlib
+GENERATE = ./gen$x '@DFT_ARG_SUFFIX@'
+DEL_ADAMODE = sed -e '/^\-\-\ \ \-\*\-\ ada\ \-\*\-.*/d'
+
+GNATHTML = `type -p gnathtml || type -p gnathtml.pl`
+GNATHP = www.gnat.com
+
+################################################################################
+ALIB = @cf_ada_package@
+ABASE = $(ALIB)-curses
+
+ADA_SRCDIR = ../src
+
+GEN_FILES0 = Base_Defs
+
+GEN_FILES1 = ACS_Map \
+ AC_Rep \
+ Base_Defs \
+ Character_Attribute_Set_Rep \
+ Color_Defs \
+ Key_Definitions \
+ Linker_Options \
+ Old_Keys \
+ Public_Variables \
+ Trace_Defs \
+ Version_Info \
+ Window_Offsets
+
+GEN_FILES2 = Menu_Opt_Rep \
+ Menu_Base_Defs \
+ Menu_Linker_Options \
+ Item_Rep
+
+GEN_FILES3 = Form_Opt_Rep \
+ Form_Base_Defs \
+ Form_Linker_Options \
+ Field_Rep
+
+GEN_FILES4 = Mouse_Base_Defs \
+ Mouse_Event_Rep \
+ Mouse_Events \
+ Panel_Linker_Options
+
+GEN_FILES5 = Chtype_Def \
+ Eti_Defs
+
+GEN_TARGETS = $(ADA_SRCDIR)/$(ABASE).ads \
+ $(ADA_SRCDIR)/$(ABASE).adb \
+ $(ADA_SRCDIR)/$(ABASE)-aux.ads \
+ $(ADA_SRCDIR)/$(ABASE)-trace.ads \
+ $(ADA_SRCDIR)/$(ABASE)-menus.ads \
+ $(ADA_SRCDIR)/$(ABASE)-forms.ads \
+ $(ADA_SRCDIR)/$(ABASE)-mouse.ads \
+ $(ADA_SRCDIR)/$(ABASE)-panels.ads \
+ $(ADA_SRCDIR)/$(ABASE)-menus-menu_user_data.ads \
+ $(ADA_SRCDIR)/$(ABASE)-menus-item_user_data.ads \
+ $(ADA_SRCDIR)/$(ABASE)-forms-form_user_data.ads \
+ $(ADA_SRCDIR)/$(ABASE)-forms-field_types.ads \
+ $(ADA_SRCDIR)/$(ABASE)-forms-field_user_data.ads \
+ $(ADA_SRCDIR)/$(ABASE)-panels-user_data.ads
+
+GEN_SRC = $(srcdir)/$(ABASE).ads.m4 \
+ $(srcdir)/$(ABASE).adb.m4 \
+ $(srcdir)/$(ABASE)-aux.ads.m4 \
+ $(srcdir)/$(ABASE)-trace.ads.m4 \
+ $(srcdir)/$(ABASE)-menus.ads.m4 \
+ $(srcdir)/$(ABASE)-forms.ads.m4 \
+ $(srcdir)/$(ABASE)-mouse.ads.m4 \
+ $(srcdir)/$(ABASE)-panels.ads.m4 \
+ $(srcdir)/$(ABASE)-menus-menu_user_data.ads.m4 \
+ $(srcdir)/$(ABASE)-menus-item_user_data.ads.m4 \
+ $(srcdir)/$(ABASE)-forms-form_user_data.ads.m4 \
+ $(srcdir)/$(ABASE)-forms-field_types.ads.m4 \
+ $(srcdir)/$(ABASE)-forms-field_user_data.ads.m4 \
+ $(srcdir)/$(ABASE)-panels-user_data.ads.m4
+
+
+all \
+libs : $(GEN_TARGETS)
+ @echo made $@
+
+sources:
+
+$(ADA_INCLUDE) \
+$(ADA_OBJECTS) :
+ sh $(top_srcdir)/mkdirs.sh $@
+
+install \
+install.libs :: $(ADA_INCLUDE)
+ @echo installing package $(ALIB) in $(ADA_INCLUDE)
+ @$(top_srcdir)/tar-copy.sh '$(ALIB)*.ad?' $(ADA_SRCDIR) $(ADA_INCLUDE)
+ @$(top_srcdir)/tar-copy.sh '$(ALIB)[-.]*.ad?' $(ADA_SRCDIR) $(ADA_INCLUDE)
+ @test $(srcdir) != ./ && $(top_srcdir)/tar-copy.sh '$(ALIB)*.ad?' $(srcdir)/../src $(ADA_INCLUDE)
+ @test $(srcdir) != ./ && $(top_srcdir)/tar-copy.sh '$(ALIB)[-.]*.ad?' $(srcdir)/../src $(ADA_INCLUDE)
+
+install \
+install.libs :: $(ADA_OBJECTS)
+ @echo installing package $(ALIB) in $(ADA_OBJECTS)
+ @-chmod a-wx $(ADA_SRCDIR)/*.ali
+ @$(top_srcdir)/tar-copy.sh '$(ALIB)*.ali' $(ADA_SRCDIR) $(ADA_OBJECTS)
+ @$(top_srcdir)/tar-copy.sh '$(ALIB)[-.]*.ali' $(ADA_SRCDIR) $(ADA_OBJECTS)
+ @-chmod u+x $(ADA_SRCDIR)/*.ali
+
+install \
+install.libs :: $(DESTDIR)$(bindir) adacurses-config
+ $(INSTALL_PROG) adacurses-config $(DESTDIR)$(bindir)/$(ADACURSES_CONFIG)
+
+uninstall \
+uninstall.libs ::
+ @echo removing package $(ALIB) from $(ADA_INCLUDE)
+ -@cd $(ADA_INCLUDE) && rm -f $(ALIB)[-.]*
+
+uninstall \
+uninstall.libs ::
+ @echo removing package $(ALIB) from $(ADA_OBJECTS)
+ -@cd $(ADA_OBJECTS) && rm -f $(ALIB)[-.]*
+
+uninstall \
+uninstall.libs ::
+ -rm -f $(DESTDIR)$(bindir)/$(ADACURSES_CONFIG)
+
+gen$x: gen.o
+ @ECHO_LINK@ $(LINK) $(CFLAGS_NORMAL) gen.o $(LD_FLAGS) -o $@
+
+gen.o: $(srcdir)/gen.c
+ $(HOST_CC) $(CFLAGS_NORMAL) -c -o $@ $(srcdir)/gen.c
+################################################################################
+Character_Attribute_Set_Rep: gen$x
+ $(WRAPPER) "$(GENERATE) B A" >$@
+
+Base_Defs: gen$x
+ $(WRAPPER) "$(GENERATE) B B" >$@
+
+Color_Defs: gen$x
+ $(WRAPPER) "$(GENERATE) B C" >$@
+
+Window_Offsets: gen$x
+ $(WRAPPER) "$(GENERATE) B D" >$@
+
+Key_Definitions: gen$x
+ $(WRAPPER) "$(GENERATE) B K" >$@
+
+Linker_Options: gen$x
+ $(WRAPPER) "$(GENERATE) B L" >$@
+
+ACS_Map: gen$x
+ $(WRAPPER) "$(GENERATE) B M" >$@
+
+Old_Keys: gen$x
+ $(WRAPPER) "$(GENERATE) B O" >$@
+
+Public_Variables: gen$x
+ $(WRAPPER) "$(GENERATE) B P" >$@
+
+AC_Rep: gen$x
+ $(WRAPPER) "$(GENERATE) B R" >$@
+
+Version_Info: gen$x
+ $(WRAPPER) "$(GENERATE) B V" >$@
+
+Trace_Defs: gen$x
+ $(WRAPPER) "$(GENERATE) B T" >$@
+################################################################################
+Menu_Opt_Rep: gen$x
+ $(WRAPPER) "$(GENERATE) M R" >$@
+
+Menu_Base_Defs: gen$x
+ $(WRAPPER) "$(GENERATE) M B" >$@
+
+Menu_Linker_Options: gen$x
+ $(WRAPPER) "$(GENERATE) M L" >$@
+
+Item_Rep: gen$x
+ $(WRAPPER) "$(GENERATE) M I" >$@
+################################################################################
+Form_Opt_Rep: gen$x
+ $(WRAPPER) "$(GENERATE) F R" >$@
+
+Form_Base_Defs: gen$x
+ $(WRAPPER) "$(GENERATE) F B" >$@
+
+Form_Linker_Options: gen$x
+ $(WRAPPER) "$(GENERATE) F L" >$@
+
+Field_Rep: gen$x
+ $(WRAPPER) "$(GENERATE) F I" >$@
+################################################################################
+Mouse_Base_Defs: gen$x
+ $(WRAPPER) "$(GENERATE) P B" >$@
+
+Mouse_Event_Rep: gen$x
+ $(WRAPPER) "$(GENERATE) P M" >$@
+
+Mouse_Events: gen$x
+ $(WRAPPER) "$(GENERATE) B E" >$@
+
+Panel_Linker_Options: gen$x
+ $(WRAPPER) "$(GENERATE) P L" >$@
+
+Chtype_Def: gen$x
+ $(WRAPPER) "$(GENERATE) E C" >$@
+
+Eti_Defs: gen$x
+ $(WRAPPER) "$(GENERATE) E E" >$@
+################################################################################
+$(ADA_SRCDIR)/$(ABASE).ads: $(srcdir)/$(ABASE).ads.m4 \
+ $(GEN_FILES1) $(srcdir)/normal.m4
+ $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
+ $(srcdir)/$(ABASE).ads.m4 |\
+ $(DEL_ADAMODE) >$@
+
+$(ADA_SRCDIR)/$(ABASE).adb: $(srcdir)/$(ABASE).adb.m4 \
+ $(GEN_FILES1) $(srcdir)/normal.m4
+ $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
+ $(srcdir)/$(ABASE).adb.m4 |\
+ $(DEL_ADAMODE) >$@
+
+$(ADA_SRCDIR)/$(ABASE)-aux.ads: $(srcdir)/$(ABASE)-aux.ads.m4 \
+ $(GEN_FILES5) $(srcdir)/normal.m4
+ $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
+ $(srcdir)/$(ABASE)-aux.ads.m4 |\
+ $(DEL_ADAMODE) >$@
+
+$(ADA_SRCDIR)/$(ABASE)-trace.ads: $(srcdir)/$(ABASE)-trace.ads.m4 \
+ $(GEN_FILES5) $(srcdir)/normal.m4
+ $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
+ $(srcdir)/$(ABASE)-trace.ads.m4 |\
+ $(DEL_ADAMODE) >$@
+
+$(ADA_SRCDIR)/$(ABASE)-menus.ads: $(srcdir)/$(ABASE)-menus.ads.m4 \
+ $(GEN_FILES2) $(srcdir)/normal.m4
+ $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
+ $(srcdir)/$(ABASE)-menus.ads.m4 |\
+ $(DEL_ADAMODE) >$@
+
+$(ADA_SRCDIR)/$(ABASE)-forms.ads: $(srcdir)/$(ABASE)-forms.ads.m4 \
+ $(GEN_FILES3) $(srcdir)/normal.m4
+ $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
+ $(srcdir)/$(ABASE)-forms.ads.m4 |\
+ $(DEL_ADAMODE) >$@
+
+$(ADA_SRCDIR)/$(ABASE)-mouse.ads: $(srcdir)/$(ABASE)-mouse.ads.m4 \
+ $(GEN_FILES4) $(srcdir)/normal.m4
+ $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
+ $(srcdir)/$(ABASE)-mouse.ads.m4 |\
+ $(DEL_ADAMODE) >$@
+
+$(ADA_SRCDIR)/$(ABASE)-panels.ads: $(srcdir)/$(ABASE)-panels.ads.m4 \
+ $(srcdir)/normal.m4
+ $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
+ $(srcdir)/$(ABASE)-panels.ads.m4 |\
+ $(DEL_ADAMODE) >$@
+
+$(ADA_SRCDIR)/$(ABASE)-menus-menu_user_data.ads: \
+ $(srcdir)/$(ABASE)-menus-menu_user_data.ads.m4 \
+ $(srcdir)/normal.m4
+ $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
+ $(srcdir)/$(ABASE)-menus-menu_user_data.ads.m4 |\
+ $(DEL_ADAMODE) >$@
+
+$(ADA_SRCDIR)/$(ABASE)-menus-item_user_data.ads: \
+ $(srcdir)/$(ABASE)-menus-item_user_data.ads.m4 \
+ $(srcdir)/normal.m4
+ $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
+ $(srcdir)/$(ABASE)-menus-item_user_data.ads.m4 |\
+ $(DEL_ADAMODE) >$@
+
+$(ADA_SRCDIR)/$(ABASE)-forms-form_user_data.ads: \
+ $(srcdir)/$(ABASE)-forms-form_user_data.ads.m4 \
+ $(srcdir)/normal.m4
+ $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
+ $(srcdir)/$(ABASE)-forms-form_user_data.ads.m4 |\
+ $(DEL_ADAMODE) >$@
+
+$(ADA_SRCDIR)/$(ABASE)-forms-field_types.ads: \
+ $(srcdir)/$(ABASE)-forms-field_types.ads.m4 \
+ $(srcdir)/normal.m4
+ $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
+ $(srcdir)/$(ABASE)-forms-field_types.ads.m4 |\
+ $(DEL_ADAMODE) >$@
+
+$(ADA_SRCDIR)/$(ABASE)-forms-field_user_data.ads: \
+ $(srcdir)/$(ABASE)-forms-field_user_data.ads.m4 \
+ $(srcdir)/normal.m4
+ $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
+ $(srcdir)/$(ABASE)-forms-field_user_data.ads.m4 |\
+ $(DEL_ADAMODE) >$@
+
+$(ADA_SRCDIR)/$(ABASE)-panels-user_data.ads: \
+ $(srcdir)/$(ABASE)-panels-user_data.ads.m4 \
+ $(srcdir)/normal.m4
+ $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
+ $(srcdir)/$(ABASE)-panels-user_data.ads.m4 |\
+ $(DEL_ADAMODE) >$@
+
+install.progs ::
+
+tags:
+ ctags *.[ch]
+
+@MAKE_UPPER_TAGS@TAGS:
+@MAKE_UPPER_TAGS@ etags *.[ch]
+
+mostlyclean ::
+ -rm -f a.out core gen$x *.o
+ -rm -f $(GEN_FILES1)
+ -rm -f $(GEN_FILES2)
+ -rm -f $(GEN_FILES3)
+ -rm -f $(GEN_FILES4)
+ -rm -f $(GEN_FILES5)
+
+clean :: mostlyclean
+ -rm -f $(GEN_TARGETS) instab.tmp *.ad[bs] *.html *.ali *.tmp
+
+distclean :: clean
+ -rm -f adacurses-config
+ -rm -f Makefile
+
+realclean :: distclean
+
+HTML_DIR = ../../doc/html/ada
+
+instab.tmp : table.m4 $(GEN_SRC)
+ @rm -f $@
+ @for f in $(GEN_SRC) ; do \
+ $(M4) $(M4FLAGS) -DM4MACRO=table.m4 $$f | $(DEL_ADAMODE) >> $@ ;\
+ done;
+
+$(HTML_DIR)/table.html : instab.tmp
+ @-touch $@
+ @-chmod +w $@
+ @echo '<!DOCTYPE HTML' > $@
+ @echo 'PUBLIC "-//IETF//DTD HTML 3.0//EN">' >> $@
+ @echo '<HTML>' >> $@
+ @echo '<HEAD>' >> $@
+ @echo '<TITLE>Correspondence between ncurses C and Ada functions</TITLE>' >>$@
+ @echo '</HEAD>' >> $@
+ @echo '<BODY>' >> $@
+ @echo '<H1>Correspondence between ncurses C and Ada functions</H1>' >>$@
+ @echo '<H2>Sorted by C function name</H2>' >>$@
+ @echo '<TABLE ALIGN=CENTER BORDER>' >>$@
+ @echo '<TR ALIGN=LEFT>' >>$@
+ @echo '<TH>C name</TH><TH>Ada name</TH><TH>man page</TH></TR>' >>$@
+ @sort < instab.tmp >> $@
+ @echo '</TABLE></BODY></HTML>' >>$@
+ @rm -f instab.tmp
+
+adahtml:
+ @find $(HTML_DIR) -type f -exec rm -f {} \;
+ @mkdir -p $(HTML_DIR)
+ cp -p ../src/*.ad[sb] . && chmod +w *.ad[sb]
+ ln -sf ../src/*.ali .
+ @echo "Filtering generated files"
+ @for f in $(GEN_SRC); do \
+ h=`basename $$f` ;\
+ g=`basename $$f .ads.m4` ;\
+ if test "$$g" != "$$h" ; then \
+ $(M4) $(M4FLAGS) -DM4MACRO=html.m4 $$f | $(DEL_ADAMODE) > $$g.ads ;\
+ echo "... $$g.ads" ;\
+ fi \
+ done
+ @-rm -f $(HTML_DIR)/$(ALIB)*.htm*
+ $(GNATHTML) -d -f $(ALIB)*.ads
+ for f in html/$(ALIB)*.htm*; do \
+ a=`basename $$f` ; \
+ sed -e 's/You may also.*body.*//' <$$f |\
+ sed -e 's%GNAT%<A HREF="http://$(GNATHP)">GNAT</A>%g' |\
+ sed -e 's%<A HREF%<A HREF%g' |\
+ sed -e 's%">%">%g' |\
+ sed -e 's/3X/3x/g' |\
+ sed -e 's/$$\([ABCDEFGHIJKLMNOPQRSTUVWXZabcdefghijklmnopqrstuvwxz0123456789_]*:.*\)\$$/@\1@/' |\
+ sed -e 's%</A>%</A>%g' > $$a.tmp ;\
+ mv $$a.tmp $$f ;\
+ done
+ @rm -f *.ad[sb] *.ali *.tmp
+ @for f in funcs.htm main.htm ; do \
+ sed -e "\%<A HREF=funcs/ .htm>\[ \]</A>%d" < html/$$f > $$f ;\
+ mv $$f html/$$f ;\
+ done
+ @rm -f "html/funcs/ .htm"
+ @cp -pdrf html/* $(HTML_DIR)/
+ @rm -rf html
+
+html : adahtml $(HTML_DIR)/table.html
+ @echo made $@
+
+###############################################################################
+# The remainder of this file is automatically generated during configuration
+###############################################################################
diff --git a/Ada95/gen/adacurses-config.in b/Ada95/gen/adacurses-config.in
new file mode 100644
index 0000000..c88d85b
--- /dev/null
+++ b/Ada95/gen/adacurses-config.in
@@ -0,0 +1,35 @@
+#! /bin/sh
+# $Id: adacurses-config.in,v 1.2 2007/04/07 21:06:50 tom Exp $
+#
+# This script will return the option to add to `gnatmake' for using
+# AdaCurses.
+#
+
+prefix="@prefix@"
+exec_prefix="@exec_prefix@"
+libdir="@libdir@"
+
+VERSION="@NCURSES_MAJOR@.@NCURSES_MINOR@.@NCURSES_PATCH@"
+
+CFLAGS="-I$libdir/adacurses -L$libdir/adacurses"
+LIBS="-L$prefix/lib -lAdaCurses"
+
+case "x$1" in
+ x--version)
+ echo AdaCurses $VERSION
+ ;;
+ x--cflags)
+ echo $CFLAGS
+ ;;
+ x--libs)
+ echo $LIBS
+ ;;
+ x)
+ # if no parameter is given, give what gnatmake needs
+ echo $CFLAGS -largs $LIBS
+ ;;
+ *)
+ echo 'Usage: adacurses-config [--version | --cflags | --libs]' >&2
+ exit 1
+ ;;
+esac
diff --git a/Ada95/gen/gen.c b/Ada95/gen/gen.c
new file mode 100644
index 0000000..d8ea44f
--- /dev/null
+++ b/Ada95/gen/gen.c
@@ -0,0 +1,1523 @@
+/****************************************************************************
+ * Copyright (c) 1998,2007,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
+ $Id: gen.c,v 1.49 2008/10/04 21:59:37 tom Exp $
+ --------------------------------------------------------------------------*/
+/*
+ This program generates various record structures and constants from the
+ ncurses header file for the Ada95 packages. Essentially it produces
+ Ada95 source on stdout, which is then merged using m4 into a template
+ to produce the real source.
+ */
+
+#include <ncurses_cfg.h>
+
+#include <stdlib.h>
+#include <stddef.h>
+#include <string.h>
+#include <assert.h>
+#include <ctype.h>
+
+#include <menu.h>
+#include <form.h>
+
+#define RES_NAME "Reserved"
+
+static const char *model = "";
+static int little_endian = 0;
+
+typedef struct
+ {
+ const char *name;
+ unsigned long attr;
+ }
+name_attribute_pair;
+
+static int
+find_pos(char *s, unsigned len, int *low, int *high)
+{
+ unsigned int i, j;
+ int l = 0;
+
+ *high = -1;
+ *low = 8 * len;
+
+ for (i = 0; i < len; i++, s++)
+ {
+ if (*s)
+ {
+ for (j = 0; j < 8 * sizeof(char); j++)
+
+ {
+ if (((little_endian && ((*s) & 0x01)) ||
+ (!little_endian && ((*s) & 0x80))))
+ {
+ if (l > *high)
+ *high = l;
+ if (l < *low)
+ *low = l;
+ }
+ l++;
+ if (little_endian)
+ *s >>= 1;
+ else
+ *s <<= 1;
+ }
+ }
+ else
+ l += 8;
+ }
+ return (*high >= 0 && (*low <= *high)) ? *low : -1;
+}
+
+/*
+ * This helper routine generates a representation clause for a
+ * record type defined in the binding.
+ * We are only dealing with record types which are of 32 or 16
+ * bit size, i.e. they fit into an (u)int or a (u)short.
+ */
+static void
+ gen_reps
+ (const name_attribute_pair * nap, /* array of name_attribute_pair records */
+ const char *name, /* name of the represented record type */
+ int len, /* size of the record in bytes */
+ int bias)
+{
+ int i, n, l, cnt = 0, low, high;
+ int width = strlen(RES_NAME) + 3;
+ unsigned long a;
+ unsigned long mask = 0;
+
+ assert(nap != NULL);
+
+ for (i = 0; nap[i].name != (char *)0; i++)
+ {
+ cnt++;
+ l = strlen(nap[i].name);
+ if (l > width)
+ width = l;
+ }
+ assert(width > 0);
+
+ printf(" type %s is\n", name);
+ printf(" record\n");
+ for (i = 0; nap[i].name != (char *)0; i++)
+ {
+ printf(" %-*s : Boolean;\n", width, nap[i].name);
+ }
+ printf(" end record;\n");
+ printf(" pragma Convention (C, %s);\n\n", name);
+
+ printf(" for %s use\n", name);
+ printf(" record\n");
+
+ for (i = 0; nap[i].name != (char *)0; i++)
+ {
+ a = nap[i].attr;
+ mask |= a;
+ l = find_pos((char *)&a, sizeof(a), &low, &high);
+ if (l >= 0)
+ printf(" %-*s at 0 range %2d .. %2d;\n", width, nap[i].name,
+ low - bias, high - bias);
+ }
+ i = 1;
+ n = cnt;
+ printf(" end record;\n");
+ printf(" for %s'Size use %d;\n", name, 8 * len);
+ printf(" -- Please note: this rep. clause is generated and may be\n");
+ printf(" -- different on your system.");
+}
+
+static void
+chtype_rep(const char *name, attr_t mask)
+{
+ attr_t x = -1;
+ attr_t t = x & mask;
+ int low, high;
+ int l = find_pos((char *)&t, sizeof(t), &low, &high);
+
+ if (l >= 0)
+ printf(" %-5s at 0 range %2d .. %2d;\n", name, low, high);
+}
+
+static void
+gen_chtype_rep(const char *name)
+{
+ printf(" for %s use\n record\n", name);
+ chtype_rep("Ch", A_CHARTEXT);
+ chtype_rep("Color", A_COLOR);
+ chtype_rep("Attr", (A_ATTRIBUTES & ~A_COLOR));
+ printf(" end record;\n for %s'Size use %ld;\n",
+ name, (long)(8 * sizeof(chtype)));
+
+ printf(" -- Please note: this rep. clause is generated and may be\n");
+ printf(" -- different on your system.\n");
+}
+
+static void
+mrep_rep(const char *name, void *rec)
+{
+ int low, high;
+ int l = find_pos((char *)rec, sizeof(MEVENT), &low, &high);
+
+ if (l >= 0)
+ printf(" %-7s at 0 range %3d .. %3d;\n", name, low, high);
+}
+
+static void
+gen_mrep_rep(const char *name)
+{
+ MEVENT x;
+
+ printf(" for %s use\n record\n", name);
+
+ memset(&x, 0, sizeof(x));
+ x.id = -1;
+ mrep_rep("Id", &x);
+
+ memset(&x, 0, sizeof(x));
+ x.x = -1;
+ mrep_rep("X", &x);
+
+ memset(&x, 0, sizeof(x));
+ x.y = -1;
+ mrep_rep("Y", &x);
+
+ memset(&x, 0, sizeof(x));
+ x.z = -1;
+ mrep_rep("Z", &x);
+
+ memset(&x, 0, sizeof(x));
+ x.bstate = -1;
+ mrep_rep("Bstate", &x);
+
+ printf(" end record;\n");
+ printf(" -- Please note: this rep. clause is generated and may be\n");
+ printf(" -- different on your system.\n");
+}
+
+static void
+gen_attr_set(const char *name)
+{
+ /* All of the A_xxx symbols are defined in ncurses, but not all are nonzero
+ * if "configure --enable-widec" is specified.
+ */
+ static const name_attribute_pair nap[] =
+ {
+#if A_STANDOUT
+ {"Stand_Out", A_STANDOUT},
+#endif
+#if A_UNDERLINE
+ {"Under_Line", A_UNDERLINE},
+#endif
+#if A_REVERSE
+ {"Reverse_Video", A_REVERSE},
+#endif
+#if A_BLINK
+ {"Blink", A_BLINK},
+#endif
+#if A_DIM
+ {"Dim_Character", A_DIM},
+#endif
+#if A_BOLD
+ {"Bold_Character", A_BOLD},
+#endif
+#if A_ALTCHARSET
+ {"Alternate_Character_Set", A_ALTCHARSET},
+#endif
+#if A_INVIS
+ {"Invisible_Character", A_INVIS},
+#endif
+#if A_PROTECT
+ {"Protected_Character", A_PROTECT},
+#endif
+#if A_HORIZONTAL
+ {"Horizontal", A_HORIZONTAL},
+#endif
+#if A_LEFT
+ {"Left", A_LEFT},
+#endif
+#if A_LOW
+ {"Low", A_LOW},
+#endif
+#if A_RIGHT
+ {"Right", A_RIGHT},
+#endif
+#if A_TOP
+ {"Top", A_TOP},
+#endif
+#if A_VERTICAL
+ {"Vertical", A_VERTICAL},
+#endif
+ {(char *)0, 0}
+ };
+ chtype attr = A_ATTRIBUTES & ~A_COLOR;
+ int start = -1;
+ int len = 0;
+ int i, set;
+ for (i = 0; i < (int)(8 * sizeof(chtype)); i++)
+
+ {
+ set = attr & 1;
+ if (set)
+ {
+ if (start < 0)
+ start = i;
+ if (start >= 0)
+ {
+ len++;
+ }
+ }
+ attr = attr >> 1;
+ }
+ gen_reps(nap, name, (len + 7) / 8, little_endian ? start : 0);
+}
+
+static void
+gen_trace(const char *name)
+{
+ static const name_attribute_pair nap[] =
+ {
+ {"Times", TRACE_TIMES},
+ {"Tputs", TRACE_TPUTS},
+ {"Update", TRACE_UPDATE},
+ {"Cursor_Move", TRACE_MOVE},
+ {"Character_Output", TRACE_CHARPUT},
+ {"Calls", TRACE_CALLS},
+ {"Virtual_Puts", TRACE_VIRTPUT},
+ {"Input_Events", TRACE_IEVENT},
+ {"TTY_State", TRACE_BITS},
+ {"Internal_Calls", TRACE_ICALLS},
+ {"Character_Calls", TRACE_CCALLS},
+ {"Termcap_TermInfo", TRACE_DATABASE},
+ {(char *)0, 0}
+ };
+ gen_reps(nap, name, sizeof(int), 0);
+}
+
+static void
+gen_menu_opt_rep(const char *name)
+{
+ static const name_attribute_pair nap[] =
+ {
+#ifdef O_ONEVALUE
+ {"One_Valued", O_ONEVALUE},
+#endif
+#ifdef O_SHOWDESC
+ {"Show_Descriptions", O_SHOWDESC},
+#endif
+#ifdef O_ROWMAJOR
+ {"Row_Major_Order", O_ROWMAJOR},
+#endif
+#ifdef O_IGNORECASE
+ {"Ignore_Case", O_IGNORECASE},
+#endif
+#ifdef O_SHOWMATCH
+ {"Show_Matches", O_SHOWMATCH},
+#endif
+#ifdef O_NONCYCLIC
+ {"Non_Cyclic", O_NONCYCLIC},
+#endif
+ {(char *)0, 0}
+ };
+ gen_reps(nap, name, sizeof(int), 0);
+}
+
+static void
+gen_item_opt_rep(const char *name)
+{
+ static const name_attribute_pair nap[] =
+ {
+#ifdef O_SELECTABLE
+ {"Selectable", O_SELECTABLE},
+#endif
+ {(char *)0, 0}
+ };
+ gen_reps(nap, name, sizeof(int), 0);
+}
+
+static void
+gen_form_opt_rep(const char *name)
+{
+ static const name_attribute_pair nap[] =
+ {
+#ifdef O_NL_OVERLOAD
+ {"NL_Overload", O_NL_OVERLOAD},
+#endif
+#ifdef O_BS_OVERLOAD
+ {"BS_Overload", O_BS_OVERLOAD},
+#endif
+ {(char *)0, 0}
+ };
+ gen_reps(nap, name, sizeof(int), 0);
+}
+
+/*
+ * Generate the representation clause for the Field_Option_Set record
+ */
+static void
+gen_field_opt_rep(const char *name)
+{
+ static const name_attribute_pair nap[] =
+ {
+#ifdef O_VISIBLE
+ {"Visible", O_VISIBLE},
+#endif
+#ifdef O_ACTIVE
+ {"Active", O_ACTIVE},
+#endif
+#ifdef O_PUBLIC
+ {"Public", O_PUBLIC},
+#endif
+#ifdef O_EDIT
+ {"Edit", O_EDIT},
+#endif
+#ifdef O_WRAP
+ {"Wrap", O_WRAP},
+#endif
+#ifdef O_BLANK
+ {"Blank", O_BLANK},
+#endif
+#ifdef O_AUTOSKIP
+ {"Auto_Skip", O_AUTOSKIP},
+#endif
+#ifdef O_NULLOK
+ {"Null_Ok", O_NULLOK},
+#endif
+#ifdef O_PASSOK
+ {"Pass_Ok", O_PASSOK},
+#endif
+#ifdef O_STATIC
+ {"Static", O_STATIC},
+#endif
+ {(char *)0, 0}
+ };
+ gen_reps(nap, name, sizeof(int), 0);
+}
+
+/*
+ * Generate a single key code constant definition.
+ */
+static void
+keydef(const char *name, const char *old_name, int value, int mode)
+{
+ if (mode == 0) /* Generate the new name */
+ printf(" %-30s : constant Special_Key_Code := 8#%3o#;\n", name, value);
+ else
+ { /* generate the old name, but only if it doesn't conflict with the old
+ * name (Ada95 isn't case sensitive!)
+ */
+ const char *s = old_name;
+ const char *t = name;
+
+ while (*s && *t && (toupper(*s++) == toupper(*t++)));
+ if (*s || *t)
+ printf(" %-16s : Special_Key_Code renames %s;\n", old_name, name);
+ }
+}
+
+/*
+ * Generate constants for the key codes. When called with mode==0, a
+ * complete list with nice constant names in proper casing style will
+ * be generated. Otherwise a list of old (i.e. C-style) names will be
+ * generated, given that the name wasn't already defined in the "nice"
+ * list.
+ */
+static void
+gen_keydefs(int mode)
+{
+ char buf[16];
+ char obuf[16];
+ int i;
+
+#ifdef KEY_CODE_YES
+ keydef("Key_Code_Yes", "KEY_CODE_YES", KEY_CODE_YES, mode);
+#endif
+#ifdef KEY_MIN
+ keydef("Key_Min", "KEY_MIN", KEY_MIN, mode);
+#endif
+#ifdef KEY_BREAK
+ keydef("Key_Break", "KEY_BREAK", KEY_BREAK, mode);
+#endif
+#ifdef KEY_DOWN
+ keydef("Key_Cursor_Down", "KEY_DOWN", KEY_DOWN, mode);
+#endif
+#ifdef KEY_UP
+ keydef("Key_Cursor_Up", "KEY_UP", KEY_UP, mode);
+#endif
+#ifdef KEY_LEFT
+ keydef("Key_Cursor_Left", "KEY_LEFT", KEY_LEFT, mode);
+#endif
+#ifdef KEY_RIGHT
+ keydef("Key_Cursor_Right", "KEY_RIGHT", KEY_RIGHT, mode);
+#endif
+#ifdef KEY_HOME
+ keydef("Key_Home", "KEY_HOME", KEY_HOME, mode);
+#endif
+#ifdef KEY_BACKSPACE
+ keydef("Key_Backspace", "KEY_BACKSPACE", KEY_BACKSPACE, mode);
+#endif
+#ifdef KEY_F0
+ keydef("Key_F0", "KEY_F0", KEY_F0, mode);
+#endif
+#ifdef KEY_F
+ for (i = 1; i <= 24; i++)
+ {
+ sprintf(buf, "Key_F%d", i);
+ sprintf(obuf, "KEY_F%d", i);
+ keydef(buf, obuf, KEY_F(i), mode);
+ }
+#endif
+#ifdef KEY_DL
+ keydef("Key_Delete_Line", "KEY_DL", KEY_DL, mode);
+#endif
+#ifdef KEY_IL
+ keydef("Key_Insert_Line", "KEY_IL", KEY_IL, mode);
+#endif
+#ifdef KEY_DC
+ keydef("Key_Delete_Char", "KEY_DC", KEY_DC, mode);
+#endif
+#ifdef KEY_IC
+ keydef("Key_Insert_Char", "KEY_IC", KEY_IC, mode);
+#endif
+#ifdef KEY_EIC
+ keydef("Key_Exit_Insert_Mode", "KEY_EIC", KEY_EIC, mode);
+#endif
+#ifdef KEY_CLEAR
+ keydef("Key_Clear_Screen", "KEY_CLEAR", KEY_CLEAR, mode);
+#endif
+#ifdef KEY_EOS
+ keydef("Key_Clear_End_Of_Screen", "KEY_EOS", KEY_EOS, mode);
+#endif
+#ifdef KEY_EOL
+ keydef("Key_Clear_End_Of_Line", "KEY_EOL", KEY_EOL, mode);
+#endif
+#ifdef KEY_SF
+ keydef("Key_Scroll_1_Forward", "KEY_SF", KEY_SF, mode);
+#endif
+#ifdef KEY_SR
+ keydef("Key_Scroll_1_Backward", "KEY_SR", KEY_SR, mode);
+#endif
+#ifdef KEY_NPAGE
+ keydef("Key_Next_Page", "KEY_NPAGE", KEY_NPAGE, mode);
+#endif
+#ifdef KEY_PPAGE
+ keydef("Key_Previous_Page", "KEY_PPAGE", KEY_PPAGE, mode);
+#endif
+#ifdef KEY_STAB
+ keydef("Key_Set_Tab", "KEY_STAB", KEY_STAB, mode);
+#endif
+#ifdef KEY_CTAB
+ keydef("Key_Clear_Tab", "KEY_CTAB", KEY_CTAB, mode);
+#endif
+#ifdef KEY_CATAB
+ keydef("Key_Clear_All_Tabs", "KEY_CATAB", KEY_CATAB, mode);
+#endif
+#ifdef KEY_ENTER
+ keydef("Key_Enter_Or_Send", "KEY_ENTER", KEY_ENTER, mode);
+#endif
+#ifdef KEY_SRESET
+ keydef("Key_Soft_Reset", "KEY_SRESET", KEY_SRESET, mode);
+#endif
+#ifdef KEY_RESET
+ keydef("Key_Reset", "KEY_RESET", KEY_RESET, mode);
+#endif
+#ifdef KEY_PRINT
+ keydef("Key_Print", "KEY_PRINT", KEY_PRINT, mode);
+#endif
+#ifdef KEY_LL
+ keydef("Key_Bottom", "KEY_LL", KEY_LL, mode);
+#endif
+#ifdef KEY_A1
+ keydef("Key_Upper_Left_Of_Keypad", "KEY_A1", KEY_A1, mode);
+#endif
+#ifdef KEY_A3
+ keydef("Key_Upper_Right_Of_Keypad", "KEY_A3", KEY_A3, mode);
+#endif
+#ifdef KEY_B2
+ keydef("Key_Center_Of_Keypad", "KEY_B2", KEY_B2, mode);
+#endif
+#ifdef KEY_C1
+ keydef("Key_Lower_Left_Of_Keypad", "KEY_C1", KEY_C1, mode);
+#endif
+#ifdef KEY_C3
+ keydef("Key_Lower_Right_Of_Keypad", "KEY_C3", KEY_C3, mode);
+#endif
+#ifdef KEY_BTAB
+ keydef("Key_Back_Tab", "KEY_BTAB", KEY_BTAB, mode);
+#endif
+#ifdef KEY_BEG
+ keydef("Key_Beginning", "KEY_BEG", KEY_BEG, mode);
+#endif
+#ifdef KEY_CANCEL
+ keydef("Key_Cancel", "KEY_CANCEL", KEY_CANCEL, mode);
+#endif
+#ifdef KEY_CLOSE
+ keydef("Key_Close", "KEY_CLOSE", KEY_CLOSE, mode);
+#endif
+#ifdef KEY_COMMAND
+ keydef("Key_Command", "KEY_COMMAND", KEY_COMMAND, mode);
+#endif
+#ifdef KEY_COPY
+ keydef("Key_Copy", "KEY_COPY", KEY_COPY, mode);
+#endif
+#ifdef KEY_CREATE
+ keydef("Key_Create", "KEY_CREATE", KEY_CREATE, mode);
+#endif
+#ifdef KEY_END
+ keydef("Key_End", "KEY_END", KEY_END, mode);
+#endif
+#ifdef KEY_EXIT
+ keydef("Key_Exit", "KEY_EXIT", KEY_EXIT, mode);
+#endif
+#ifdef KEY_FIND
+ keydef("Key_Find", "KEY_FIND", KEY_FIND, mode);
+#endif
+#ifdef KEY_HELP
+ keydef("Key_Help", "KEY_HELP", KEY_HELP, mode);
+#endif
+#ifdef KEY_MARK
+ keydef("Key_Mark", "KEY_MARK", KEY_MARK, mode);
+#endif
+#ifdef KEY_MESSAGE
+ keydef("Key_Message", "KEY_MESSAGE", KEY_MESSAGE, mode);
+#endif
+#ifdef KEY_MOVE
+ keydef("Key_Move", "KEY_MOVE", KEY_MOVE, mode);
+#endif
+#ifdef KEY_NEXT
+ keydef("Key_Next", "KEY_NEXT", KEY_NEXT, mode);
+#endif
+#ifdef KEY_OPEN
+ keydef("Key_Open", "KEY_OPEN", KEY_OPEN, mode);
+#endif
+#ifdef KEY_OPTIONS
+ keydef("Key_Options", "KEY_OPTIONS", KEY_OPTIONS, mode);
+#endif
+#ifdef KEY_PREVIOUS
+ keydef("Key_Previous", "KEY_PREVIOUS", KEY_PREVIOUS, mode);
+#endif
+#ifdef KEY_REDO
+ keydef("Key_Redo", "KEY_REDO", KEY_REDO, mode);
+#endif
+#ifdef KEY_REFERENCE
+ keydef("Key_Reference", "KEY_REFERENCE", KEY_REFERENCE, mode);
+#endif
+#ifdef KEY_REFRESH
+ keydef("Key_Refresh", "KEY_REFRESH", KEY_REFRESH, mode);
+#endif
+#ifdef KEY_REPLACE
+ keydef("Key_Replace", "KEY_REPLACE", KEY_REPLACE, mode);
+#endif
+#ifdef KEY_RESTART
+ keydef("Key_Restart", "KEY_RESTART", KEY_RESTART, mode);
+#endif
+#ifdef KEY_RESUME
+ keydef("Key_Resume", "KEY_RESUME", KEY_RESUME, mode);
+#endif
+#ifdef KEY_SAVE
+ keydef("Key_Save", "KEY_SAVE", KEY_SAVE, mode);
+#endif
+#ifdef KEY_SBEG
+ keydef("Key_Shift_Begin", "KEY_SBEG", KEY_SBEG, mode);
+#endif
+#ifdef KEY_SCANCEL
+ keydef("Key_Shift_Cancel", "KEY_SCANCEL", KEY_SCANCEL, mode);
+#endif
+#ifdef KEY_SCOMMAND
+ keydef("Key_Shift_Command", "KEY_SCOMMAND", KEY_SCOMMAND, mode);
+#endif
+#ifdef KEY_SCOPY
+ keydef("Key_Shift_Copy", "KEY_SCOPY", KEY_SCOPY, mode);
+#endif
+#ifdef KEY_SCREATE
+ keydef("Key_Shift_Create", "KEY_SCREATE", KEY_SCREATE, mode);
+#endif
+#ifdef KEY_SDC
+ keydef("Key_Shift_Delete_Char", "KEY_SDC", KEY_SDC, mode);
+#endif
+#ifdef KEY_SDL
+ keydef("Key_Shift_Delete_Line", "KEY_SDL", KEY_SDL, mode);
+#endif
+#ifdef KEY_SELECT
+ keydef("Key_Select", "KEY_SELECT", KEY_SELECT, mode);
+#endif
+#ifdef KEY_SEND
+ keydef("Key_Shift_End", "KEY_SEND", KEY_SEND, mode);
+#endif
+#ifdef KEY_SEOL
+ keydef("Key_Shift_Clear_End_Of_Line", "KEY_SEOL", KEY_SEOL, mode);
+#endif
+#ifdef KEY_SEXIT
+ keydef("Key_Shift_Exit", "KEY_SEXIT", KEY_SEXIT, mode);
+#endif
+#ifdef KEY_SFIND
+ keydef("Key_Shift_Find", "KEY_SFIND", KEY_SFIND, mode);
+#endif
+#ifdef KEY_SHELP
+ keydef("Key_Shift_Help", "KEY_SHELP", KEY_SHELP, mode);
+#endif
+#ifdef KEY_SHOME
+ keydef("Key_Shift_Home", "KEY_SHOME", KEY_SHOME, mode);
+#endif
+#ifdef KEY_SIC
+ keydef("Key_Shift_Insert_Char", "KEY_SIC", KEY_SIC, mode);
+#endif
+#ifdef KEY_SLEFT
+ keydef("Key_Shift_Cursor_Left", "KEY_SLEFT", KEY_SLEFT, mode);
+#endif
+#ifdef KEY_SMESSAGE
+ keydef("Key_Shift_Message", "KEY_SMESSAGE", KEY_SMESSAGE, mode);
+#endif
+#ifdef KEY_SMOVE
+ keydef("Key_Shift_Move", "KEY_SMOVE", KEY_SMOVE, mode);
+#endif
+#ifdef KEY_SNEXT
+ keydef("Key_Shift_Next_Page", "KEY_SNEXT", KEY_SNEXT, mode);
+#endif
+#ifdef KEY_SOPTIONS
+ keydef("Key_Shift_Options", "KEY_SOPTIONS", KEY_SOPTIONS, mode);
+#endif
+#ifdef KEY_SPREVIOUS
+ keydef("Key_Shift_Previous_Page", "KEY_SPREVIOUS", KEY_SPREVIOUS, mode);
+#endif
+#ifdef KEY_SPRINT
+ keydef("Key_Shift_Print", "KEY_SPRINT", KEY_SPRINT, mode);
+#endif
+#ifdef KEY_SREDO
+ keydef("Key_Shift_Redo", "KEY_SREDO", KEY_SREDO, mode);
+#endif
+#ifdef KEY_SREPLACE
+ keydef("Key_Shift_Replace", "KEY_SREPLACE", KEY_SREPLACE, mode);
+#endif
+#ifdef KEY_SRIGHT
+ keydef("Key_Shift_Cursor_Right", "KEY_SRIGHT", KEY_SRIGHT, mode);
+#endif
+#ifdef KEY_SRSUME
+ keydef("Key_Shift_Resume", "KEY_SRSUME", KEY_SRSUME, mode);
+#endif
+#ifdef KEY_SSAVE
+ keydef("Key_Shift_Save", "KEY_SSAVE", KEY_SSAVE, mode);
+#endif
+#ifdef KEY_SSUSPEND
+ keydef("Key_Shift_Suspend", "KEY_SSUSPEND", KEY_SSUSPEND, mode);
+#endif
+#ifdef KEY_SUNDO
+ keydef("Key_Shift_Undo", "KEY_SUNDO", KEY_SUNDO, mode);
+#endif
+#ifdef KEY_SUSPEND
+ keydef("Key_Suspend", "KEY_SUSPEND", KEY_SUSPEND, mode);
+#endif
+#ifdef KEY_UNDO
+ keydef("Key_Undo", "KEY_UNDO", KEY_UNDO, mode);
+#endif
+#ifdef KEY_MOUSE
+ keydef("Key_Mouse", "KEY_MOUSE", KEY_MOUSE, mode);
+#endif
+#ifdef KEY_RESIZE
+ keydef("Key_Resize", "KEY_RESIZE", KEY_RESIZE, mode);
+#endif
+}
+
+/*
+ * Generate a constant with the given name. The second parameter
+ * is a reference to the ACS character in the acs_map[] array and
+ * will be translated into an index.
+ */
+static void
+acs_def(const char *name, chtype *a)
+{
+ int c = a - &acs_map[0];
+
+ printf(" %-24s : constant Character := ", name);
+ if (isprint(c) && (c != '`'))
+ printf("'%c';\n", c);
+ else
+ printf("Character'Val (%d);\n", c);
+}
+
+/*
+ * Generate the constants for the ACS characters
+ */
+static void
+gen_acs(void)
+{
+ printf(" type C_ACS_Map is array (Character'Val (0) .. Character'Val (127))\n");
+ printf(" of Attributed_Character;\n");
+#if USE_REENTRANT || BROKEN_LINKER
+ printf(" type C_ACS_Ptr is access C_ACS_Map;\n");
+ printf(" function ACS_Map return C_ACS_Ptr;\n");
+ printf(" pragma Import (C, ACS_Map, \"_nc_acs_map\");\n");
+#else
+ printf(" ACS_Map : C_ACS_Map;\n");
+ printf(" pragma Import (C, ACS_Map, \"acs_map\");\n");
+#endif
+ printf(" --\n");
+ printf(" --\n");
+ printf(" -- Constants for several characters from the Alternate Character Set\n");
+ printf(" -- You must use these constants as indices into the ACS_Map array\n");
+ printf(" -- to get the corresponding attributed character at runtime.\n");
+ printf(" --\n");
+
+#ifdef ACS_ULCORNER
+ acs_def("ACS_Upper_Left_Corner", &ACS_ULCORNER);
+#endif
+#ifdef ACS_LLCORNER
+ acs_def("ACS_Lower_Left_Corner", &ACS_LLCORNER);
+#endif
+#ifdef ACS_URCORNER
+ acs_def("ACS_Upper_Right_Corner", &ACS_URCORNER);
+#endif
+#ifdef ACS_LRCORNER
+ acs_def("ACS_Lower_Right_Corner", &ACS_LRCORNER);
+#endif
+#ifdef ACS_LTEE
+ acs_def("ACS_Left_Tee", &ACS_LTEE);
+#endif
+#ifdef ACS_RTEE
+ acs_def("ACS_Right_Tee", &ACS_RTEE);
+#endif
+#ifdef ACS_BTEE
+ acs_def("ACS_Bottom_Tee", &ACS_BTEE);
+#endif
+#ifdef ACS_TTEE
+ acs_def("ACS_Top_Tee", &ACS_TTEE);
+#endif
+#ifdef ACS_HLINE
+ acs_def("ACS_Horizontal_Line", &ACS_HLINE);
+#endif
+#ifdef ACS_VLINE
+ acs_def("ACS_Vertical_Line", &ACS_VLINE);
+#endif
+#ifdef ACS_PLUS
+ acs_def("ACS_Plus_Symbol", &ACS_PLUS);
+#endif
+#ifdef ACS_S1
+ acs_def("ACS_Scan_Line_1", &ACS_S1);
+#endif
+#ifdef ACS_S9
+ acs_def("ACS_Scan_Line_9", &ACS_S9);
+#endif
+#ifdef ACS_DIAMOND
+ acs_def("ACS_Diamond", &ACS_DIAMOND);
+#endif
+#ifdef ACS_CKBOARD
+ acs_def("ACS_Checker_Board", &ACS_CKBOARD);
+#endif
+#ifdef ACS_DEGREE
+ acs_def("ACS_Degree", &ACS_DEGREE);
+#endif
+#ifdef ACS_PLMINUS
+ acs_def("ACS_Plus_Minus", &ACS_PLMINUS);
+#endif
+#ifdef ACS_BULLET
+ acs_def("ACS_Bullet", &ACS_BULLET);
+#endif
+#ifdef ACS_LARROW
+ acs_def("ACS_Left_Arrow", &ACS_LARROW);
+#endif
+#ifdef ACS_RARROW
+ acs_def("ACS_Right_Arrow", &ACS_RARROW);
+#endif
+#ifdef ACS_DARROW
+ acs_def("ACS_Down_Arrow", &ACS_DARROW);
+#endif
+#ifdef ACS_UARROW
+ acs_def("ACS_Up_Arrow", &ACS_UARROW);
+#endif
+#ifdef ACS_BOARD
+ acs_def("ACS_Board_Of_Squares", &ACS_BOARD);
+#endif
+#ifdef ACS_LANTERN
+ acs_def("ACS_Lantern", &ACS_LANTERN);
+#endif
+#ifdef ACS_BLOCK
+ acs_def("ACS_Solid_Block", &ACS_BLOCK);
+#endif
+#ifdef ACS_S3
+ acs_def("ACS_Scan_Line_3", &ACS_S3);
+#endif
+#ifdef ACS_S7
+ acs_def("ACS_Scan_Line_7", &ACS_S7);
+#endif
+#ifdef ACS_LEQUAL
+ acs_def("ACS_Less_Or_Equal", &ACS_LEQUAL);
+#endif
+#ifdef ACS_GEQUAL
+ acs_def("ACS_Greater_Or_Equal", &ACS_GEQUAL);
+#endif
+#ifdef ACS_PI
+ acs_def("ACS_PI", &ACS_PI);
+#endif
+#ifdef ACS_NEQUAL
+ acs_def("ACS_Not_Equal", &ACS_NEQUAL);
+#endif
+#ifdef ACS_STERLING
+ acs_def("ACS_Sterling", &ACS_STERLING);
+#endif
+}
+
+#define GEN_EVENT(name,value) \
+ printf(" %-25s : constant Event_Mask := 8#%011lo#;\n", \
+ #name, value)
+
+#define GEN_MEVENT(name) \
+ printf(" %-25s : constant Event_Mask := 8#%011lo#;\n", \
+ #name, name)
+
+static void
+gen_mouse_events(void)
+{
+ mmask_t all1 = 0;
+ mmask_t all2 = 0;
+ mmask_t all3 = 0;
+ mmask_t all4 = 0;
+
+#ifdef BUTTON1_RELEASED
+ GEN_MEVENT(BUTTON1_RELEASED);
+ all1 |= BUTTON1_RELEASED;
+#endif
+#ifdef BUTTON1_PRESSED
+ GEN_MEVENT(BUTTON1_PRESSED);
+ all1 |= BUTTON1_PRESSED;
+#endif
+#ifdef BUTTON1_CLICKED
+ GEN_MEVENT(BUTTON1_CLICKED);
+ all1 |= BUTTON1_CLICKED;
+#endif
+#ifdef BUTTON1_DOUBLE_CLICKED
+ GEN_MEVENT(BUTTON1_DOUBLE_CLICKED);
+ all1 |= BUTTON1_DOUBLE_CLICKED;
+#endif
+#ifdef BUTTON1_TRIPLE_CLICKED
+ GEN_MEVENT(BUTTON1_TRIPLE_CLICKED);
+ all1 |= BUTTON1_TRIPLE_CLICKED;
+#endif
+#ifdef BUTTON1_RESERVED_EVENT
+ GEN_MEVENT(BUTTON1_RESERVED_EVENT);
+ all1 |= BUTTON1_RESERVED_EVENT;
+#endif
+#ifdef BUTTON2_RELEASED
+ GEN_MEVENT(BUTTON2_RELEASED);
+ all2 |= BUTTON2_RELEASED;
+#endif
+#ifdef BUTTON2_PRESSED
+ GEN_MEVENT(BUTTON2_PRESSED);
+ all2 |= BUTTON2_PRESSED;
+#endif
+#ifdef BUTTON2_CLICKED
+ GEN_MEVENT(BUTTON2_CLICKED);
+ all2 |= BUTTON2_CLICKED;
+#endif
+#ifdef BUTTON2_DOUBLE_CLICKED
+ GEN_MEVENT(BUTTON2_DOUBLE_CLICKED);
+ all2 |= BUTTON2_DOUBLE_CLICKED;
+#endif
+#ifdef BUTTON2_TRIPLE_CLICKED
+ GEN_MEVENT(BUTTON2_TRIPLE_CLICKED);
+ all2 |= BUTTON2_TRIPLE_CLICKED;
+#endif
+#ifdef BUTTON2_RESERVED_EVENT
+ GEN_MEVENT(BUTTON2_RESERVED_EVENT);
+ all2 |= BUTTON2_RESERVED_EVENT;
+#endif
+#ifdef BUTTON3_RELEASED
+ GEN_MEVENT(BUTTON3_RELEASED);
+ all3 |= BUTTON3_RELEASED;
+#endif
+#ifdef BUTTON3_PRESSED
+ GEN_MEVENT(BUTTON3_PRESSED);
+ all3 |= BUTTON3_PRESSED;
+#endif
+#ifdef BUTTON3_CLICKED
+ GEN_MEVENT(BUTTON3_CLICKED);
+ all3 |= BUTTON3_CLICKED;
+#endif
+#ifdef BUTTON3_DOUBLE_CLICKED
+ GEN_MEVENT(BUTTON3_DOUBLE_CLICKED);
+ all3 |= BUTTON3_DOUBLE_CLICKED;
+#endif
+#ifdef BUTTON3_TRIPLE_CLICKED
+ GEN_MEVENT(BUTTON3_TRIPLE_CLICKED);
+ all3 |= BUTTON3_TRIPLE_CLICKED;
+#endif
+#ifdef BUTTON3_RESERVED_EVENT
+ GEN_MEVENT(BUTTON3_RESERVED_EVENT);
+ all3 |= BUTTON3_RESERVED_EVENT;
+#endif
+#ifdef BUTTON4_RELEASED
+ GEN_MEVENT(BUTTON4_RELEASED);
+ all4 |= BUTTON4_RELEASED;
+#endif
+#ifdef BUTTON4_PRESSED
+ GEN_MEVENT(BUTTON4_PRESSED);
+ all4 |= BUTTON4_PRESSED;
+#endif
+#ifdef BUTTON4_CLICKED
+ GEN_MEVENT(BUTTON4_CLICKED);
+ all4 |= BUTTON4_CLICKED;
+#endif
+#ifdef BUTTON4_DOUBLE_CLICKED
+ GEN_MEVENT(BUTTON4_DOUBLE_CLICKED);
+ all4 |= BUTTON4_DOUBLE_CLICKED;
+#endif
+#ifdef BUTTON4_TRIPLE_CLICKED
+ GEN_MEVENT(BUTTON4_TRIPLE_CLICKED);
+ all4 |= BUTTON4_TRIPLE_CLICKED;
+#endif
+#ifdef BUTTON4_RESERVED_EVENT
+ GEN_MEVENT(BUTTON4_RESERVED_EVENT);
+ all4 |= BUTTON4_RESERVED_EVENT;
+#endif
+#ifdef BUTTON_CTRL
+ GEN_MEVENT(BUTTON_CTRL);
+#endif
+#ifdef BUTTON_SHIFT
+ GEN_MEVENT(BUTTON_SHIFT);
+#endif
+#ifdef BUTTON_ALT
+ GEN_MEVENT(BUTTON_ALT);
+#endif
+#ifdef REPORT_MOUSE_POSITION
+ GEN_MEVENT(REPORT_MOUSE_POSITION);
+#endif
+#ifdef ALL_MOUSE_EVENTS
+ GEN_MEVENT(ALL_MOUSE_EVENTS);
+#endif
+
+ GEN_EVENT(BUTTON1_EVENTS, all1);
+ GEN_EVENT(BUTTON2_EVENTS, all2);
+ GEN_EVENT(BUTTON3_EVENTS, all3);
+ GEN_EVENT(BUTTON4_EVENTS, all4);
+}
+
+static void
+wrap_one_var(const char *c_var,
+ const char *c_type,
+ const char *ada_func,
+ const char *ada_type)
+{
+#if USE_REENTRANT
+ /* must wrap variables */
+ printf("\n");
+ printf(" function %s return %s\n", ada_func, ada_type);
+ printf(" is\n");
+ printf(" function Result return %s;\n", c_type);
+ printf(" pragma Import (C, Result, \"_nc_%s\");\n", c_var);
+ printf(" begin\n");
+ if (strcmp(c_type, ada_type))
+ printf(" return %s (Result);\n", ada_type);
+ else
+ printf(" return Result;\n");
+ printf(" end %s;\n", ada_func);
+#else
+ /* global variables are really global */
+ printf("\n");
+ printf(" function %s return %s\n", ada_func, ada_type);
+ printf(" is\n");
+ printf(" Result : %s;\n", c_type);
+ printf(" pragma Import (C, Result, \"%s\");\n", c_var);
+ printf(" begin\n");
+ if (strcmp(c_type, ada_type))
+ printf(" return %s (Result);\n", ada_type);
+ else
+ printf(" return Result;\n");
+ printf(" end %s;\n", ada_func);
+#endif
+}
+
+#define GEN_PUBLIC_VAR(c_var, c_type, ada_func, ada_type) \
+ wrap_one_var(#c_var, #c_type, #ada_func, #ada_type)
+
+static void
+gen_public_vars(void)
+{
+ GEN_PUBLIC_VAR(stdscr, Window, Standard_Window, Window);
+ GEN_PUBLIC_VAR(curscr, Window, Current_Window, Window);
+ GEN_PUBLIC_VAR(LINES, C_Int, Lines, Line_Count);
+ GEN_PUBLIC_VAR(COLS, C_Int, Columns, Column_Count);
+ GEN_PUBLIC_VAR(TABSIZE, C_Int, Tab_Size, Natural);
+ GEN_PUBLIC_VAR(COLORS, C_Int, Number_Of_Colors, Natural);
+ GEN_PUBLIC_VAR(COLOR_PAIRS, C_Int, Number_Of_Color_Pairs, Natural);
+}
+
+/*
+ * Output some comment lines indicating that the file is generated.
+ * The name parameter is the name of the facility to be used in
+ * the comment.
+ */
+static void
+prologue(const char *name)
+{
+ printf("-- %s binding.\n", name);
+ printf("-- This module is generated. Please don't change it manually!\n");
+ printf("-- Run the generator instead.\n-- |");
+
+ printf("define(`M4_BIT_ORDER',`%s_Order_First')",
+ little_endian ? "Low" : "High");
+}
+
+/*
+ * Write the prologue for the curses facility and make sure that
+ * KEY_MIN and KEY_MAX are defined for the rest of this source.
+ */
+static void
+basedefs(void)
+{
+ prologue("curses");
+#ifndef KEY_MAX
+# define KEY_MAX 0777
+#endif
+ printf("define(`M4_KEY_MAX',`8#%o#')", KEY_MAX);
+#ifndef KEY_MIN
+# define KEY_MIN 0401
+#endif
+ if (KEY_MIN == 256)
+ {
+ fprintf(stderr, "Unexpected value for KEY_MIN: %d\n", KEY_MIN);
+ exit(1);
+ }
+ printf("define(`M4_SPECIAL_FIRST',`8#%o#')", KEY_MIN - 1);
+}
+
+/*
+ * Write out the comment lines for the menu facility
+ */
+static void
+menu_basedefs(void)
+{
+ prologue("menu");
+}
+
+/*
+ * Write out the comment lines for the form facility
+ */
+static void
+form_basedefs(void)
+{
+ prologue("form");
+}
+
+/*
+ * Write out the comment lines for the mouse facility
+ */
+static void
+mouse_basedefs(void)
+{
+ prologue("mouse");
+}
+
+/*
+ * Write the definition of a single color
+ */
+static void
+color_def(const char *name, int value)
+{
+ printf(" %-16s : constant Color_Number := %d;\n", name, value);
+}
+
+/*
+ * Generate all color definitions
+ */
+static void
+gen_color(void)
+{
+#if HAVE_USE_DEFAULT_COLORS
+ color_def("Default_Color", -1);
+#endif
+#ifdef COLOR_BLACK
+ color_def("Black", COLOR_BLACK);
+#endif
+#ifdef COLOR_RED
+ color_def("Red", COLOR_RED);
+#endif
+#ifdef COLOR_GREEN
+ color_def("Green", COLOR_GREEN);
+#endif
+#ifdef COLOR_YELLOW
+ color_def("Yellow", COLOR_YELLOW);
+#endif
+#ifdef COLOR_BLUE
+ color_def("Blue", COLOR_BLUE);
+#endif
+#ifdef COLOR_MAGENTA
+ color_def("Magenta", COLOR_MAGENTA);
+#endif
+#ifdef COLOR_CYAN
+ color_def("Cyan", COLOR_CYAN);
+#endif
+#ifdef COLOR_WHITE
+ color_def("White", COLOR_WHITE);
+#endif
+}
+
+/*
+ * Generate the linker options for the base facility
+ */
+static void
+gen_linkopts(void)
+{
+ printf(" pragma Linker_Options (\"-lncurses%s\");\n", model);
+}
+
+/*
+ * Generate the linker options for the menu facility
+ */
+static void
+gen_menu_linkopts(void)
+{
+ printf(" pragma Linker_Options (\"-lmenu%s\");\n", model);
+}
+
+/*
+ * Generate the linker options for the form facility
+ */
+static void
+gen_form_linkopts(void)
+{
+ printf(" pragma Linker_Options (\"-lform%s\");\n", model);
+}
+
+/*
+ * Generate the linker options for the panel facility
+ */
+static void
+gen_panel_linkopts(void)
+{
+ printf(" pragma Linker_Options (\"-lpanel%s\");\n", model);
+}
+
+static void
+gen_version_info(void)
+{
+ static const char *v1 =
+ " NC_Major_Version : constant := %d; -- Major version of the library\n";
+ static const char *v2 =
+ " NC_Minor_Version : constant := %d; -- Minor version of the library\n";
+ static const char *v3 =
+ " NC_Version : constant String := %c%d.%d%c; -- Version of library\n";
+
+ printf(v1, NCURSES_VERSION_MAJOR);
+ printf(v2, NCURSES_VERSION_MINOR);
+ printf(v3, '"', NCURSES_VERSION_MAJOR, NCURSES_VERSION_MINOR, '"');
+}
+
+static int
+eti_gen(char *buf, int code, const char *name, int *etimin, int *etimax)
+{
+ sprintf(buf, " E_%-16s : constant Eti_Error := %d;\n", name, code);
+ if (code < *etimin)
+ *etimin = code;
+ if (code > *etimax)
+ *etimax = code;
+ return strlen(buf);
+}
+
+static void
+gen_offsets(void)
+{
+ const char *s_bool = "";
+
+ if (sizeof(bool) == sizeof(char))
+ {
+ s_bool = "char";
+ }
+ else if (sizeof(bool) == sizeof(short))
+ {
+ s_bool = "short";
+ }
+ else if (sizeof(bool) == sizeof(int))
+ {
+ s_bool = "int";
+ }
+ printf(" Sizeof%-*s : constant Natural := %2ld; -- %s\n",
+ 12, "_bool", (long)sizeof(bool), "bool");
+
+ /* In ncurses _maxy and _maxx needs an offset for the "public"
+ * value
+ */
+ printf(" Offset%-*s : constant Natural := %2d; -- %s\n",
+ 12, "_XY", 1, "int");
+ printf("\n");
+ printf(" type Curses_Bool is mod 2 ** Interfaces.C.%s'Size;\n", s_bool);
+}
+
+/*
+ * main() expects two arguments on the commandline, both single characters.
+ * The first character denotes the facility for which we generate output.
+ * Possible values are
+ * B - Base
+ * M - Menus
+ * F - Forms
+ * P - Pointer Device (Mouse)
+ * E - ETI base definitions
+ *
+ * The second character then denotes the specific output that should be
+ * generated for the selected facility.
+ */
+int
+main(int argc, char *argv[])
+{
+ int x = 0x12345678;
+ char *s = (char *)&x;
+
+ if (*s == 0x78)
+ little_endian = 1;
+
+ if (argc != 4)
+ exit(1);
+ model = *++argv;
+
+ switch (argv[1][0])
+ {
+ /* --------------------------------------------------------------- */
+ case 'B': /* The Base facility */
+ switch (argv[2][0])
+ {
+ case 'A': /* chtype translation into Ada95 record type */
+ gen_attr_set("Character_Attribute_Set");
+ break;
+ case 'B': /* write some initial comment lines */
+ basedefs();
+ break;
+ case 'C': /* generate color constants */
+ gen_color();
+ break;
+ case 'D': /* generate displacements of fields in WINDOW struct. */
+ gen_offsets();
+ break;
+ case 'E': /* generate Mouse Event codes */
+ gen_mouse_events();
+ break;
+ case 'K': /* translation of keycodes */
+ gen_keydefs(0);
+ break;
+ case 'L': /* generate the Linker_Options pragma */
+ gen_linkopts();
+ break;
+ case 'M': /* generate constants for the ACS characters */
+ gen_acs();
+ break;
+ case 'O': /* generate definitions of the old key code names */
+ gen_keydefs(1);
+ break;
+ case 'P': /* generate definitions of the public variables */
+ gen_public_vars();
+ break;
+ case 'R': /* generate representation clause for Attributed character */
+ gen_chtype_rep("Attributed_Character");
+ break;
+ case 'T': /* generate the Trace info */
+ gen_trace("Trace_Attribute_Set");
+ break;
+ case 'V': /* generate version info */
+ gen_version_info();
+ break;
+ default:
+ break;
+ }
+ break;
+ /* --------------------------------------------------------------- */
+ case 'M': /* The Menu facility */
+ switch (argv[2][0])
+ {
+ case 'R': /* generate representation clause for Menu_Option_Set */
+ gen_menu_opt_rep("Menu_Option_Set");
+ break;
+ case 'B': /* write some initial comment lines */
+ menu_basedefs();
+ break;
+ case 'L': /* generate the Linker_Options pragma */
+ gen_menu_linkopts();
+ break;
+ case 'I': /* generate representation clause for Item_Option_Set */
+ gen_item_opt_rep("Item_Option_Set");
+ break;
+ default:
+ break;
+ }
+ break;
+ /* --------------------------------------------------------------- */
+ case 'F': /* The Form facility */
+ switch (argv[2][0])
+ {
+ case 'R': /* generate representation clause for Form_Option_Set */
+ gen_form_opt_rep("Form_Option_Set");
+ break;
+ case 'B': /* write some initial comment lines */
+ form_basedefs();
+ break;
+ case 'L': /* generate the Linker_Options pragma */
+ gen_form_linkopts();
+ break;
+ case 'I': /* generate representation clause for Field_Option_Set */
+ gen_field_opt_rep("Field_Option_Set");
+ break;
+ default:
+ break;
+ }
+ break;
+ /* --------------------------------------------------------------- */
+ case 'P': /* The Pointer(=Mouse) facility */
+ switch (argv[2][0])
+ {
+ case 'B': /* write some initial comment lines */
+ mouse_basedefs();
+ break;
+ case 'M': /* generate representation clause for Mouse_Event */
+ gen_mrep_rep("Mouse_Event");
+ break;
+ case 'L': /* generate the Linker_Options pragma */
+ gen_panel_linkopts();
+ break;
+ default:
+ break;
+ }
+ break;
+ /* --------------------------------------------------------------- */
+ case 'E': /* chtype size detection */
+ switch (argv[2][0])
+ {
+ case 'C':
+ {
+ const char *fmt = " type C_Chtype is new %s;\n";
+ const char *afmt = " type C_AttrType is new %s;\n";
+
+ if (sizeof(chtype) == sizeof(int))
+ {
+ if (sizeof(int) == sizeof(long))
+ printf(fmt, "C_ULong");
+
+ else
+ printf(fmt, "C_UInt");
+ }
+ else if (sizeof(chtype) == sizeof(long))
+ {
+ printf(fmt, "C_ULong");
+ }
+ else
+ printf("Error\n");
+
+ if (sizeof(attr_t) == sizeof(int))
+ {
+ if (sizeof(int) == sizeof(long))
+ printf(afmt, "C_ULong");
+
+ else
+ printf(afmt, "C_UInt");
+ }
+ else if (sizeof(attr_t) == sizeof(long))
+ {
+ printf(afmt, "C_ULong");
+ }
+ else
+ printf("Error\n");
+
+ printf("define(`CF_CURSES_OK',`%d')", OK);
+ printf("define(`CF_CURSES_ERR',`%d')", ERR);
+ printf("define(`CF_CURSES_TRUE',`%d')", TRUE);
+ printf("define(`CF_CURSES_FALSE',`%d')", FALSE);
+ }
+ break;
+ case 'E':
+ {
+ char *buf = (char *)malloc(2048);
+ char *p = buf;
+ int etimin = E_OK;
+ int etimax = E_OK;
+
+ if (p)
+ {
+ p += eti_gen(p, E_OK, "Ok", &etimin, &etimax);
+ p += eti_gen(p, E_SYSTEM_ERROR, "System_Error", &etimin, &etimax);
+ p += eti_gen(p, E_BAD_ARGUMENT, "Bad_Argument", &etimin, &etimax);
+ p += eti_gen(p, E_POSTED, "Posted", &etimin, &etimax);
+ p += eti_gen(p, E_CONNECTED, "Connected", &etimin, &etimax);
+ p += eti_gen(p, E_BAD_STATE, "Bad_State", &etimin, &etimax);
+ p += eti_gen(p, E_NO_ROOM, "No_Room", &etimin, &etimax);
+ p += eti_gen(p, E_NOT_POSTED, "Not_Posted", &etimin, &etimax);
+ p += eti_gen(p, E_UNKNOWN_COMMAND,
+ "Unknown_Command", &etimin, &etimax);
+ p += eti_gen(p, E_NO_MATCH, "No_Match", &etimin, &etimax);
+ p += eti_gen(p, E_NOT_SELECTABLE,
+ "Not_Selectable", &etimin, &etimax);
+ p += eti_gen(p, E_NOT_CONNECTED,
+ "Not_Connected", &etimin, &etimax);
+ p += eti_gen(p, E_REQUEST_DENIED,
+ "Request_Denied", &etimin, &etimax);
+ p += eti_gen(p, E_INVALID_FIELD,
+ "Invalid_Field", &etimin, &etimax);
+ p += eti_gen(p, E_CURRENT,
+ "Current", &etimin, &etimax);
+ }
+ printf(" subtype Eti_Error is C_Int range %d .. %d;\n\n",
+ etimin, etimax);
+ printf(buf);
+ }
+ break;
+ default:
+ break;
+ }
+ break;
+ /* --------------------------------------------------------------- */
+ case 'V': /* plain version dump */
+ {
+ switch (argv[2][0])
+ {
+ case '1': /* major version */
+#ifdef NCURSES_VERSION_MAJOR
+ printf("%d", NCURSES_VERSION_MAJOR);
+#endif
+ break;
+ case '2': /* minor version */
+#ifdef NCURSES_VERSION_MINOR
+ printf("%d", NCURSES_VERSION_MINOR);
+#endif
+ break;
+ case '3': /* patch level */
+#ifdef NCURSES_VERSION_PATCH
+ printf("%d", NCURSES_VERSION_PATCH);
+#endif
+ break;
+ default:
+ break;
+ }
+ }
+ break;
+ /* --------------------------------------------------------------- */
+ default:
+ break;
+ }
+ return 0;
+}
diff --git a/Ada95/gen/html.m4 b/Ada95/gen/html.m4
new file mode 100644
index 0000000..8df2653
--- /dev/null
+++ b/Ada95/gen/html.m4
@@ -0,0 +1,40 @@
+dnl***************************************************************************
+dnl Copyright (c) 2000-2006,2007 Free Software Foundation, Inc. *
+dnl *
+dnl Permission is hereby granted, free of charge, to any person obtaining a *
+dnl copy of this software and associated documentation files (the *
+dnl "Software"), to deal in the Software without restriction, including *
+dnl without limitation the rights to use, copy, modify, merge, publish, *
+dnl distribute, distribute with modifications, sublicense, and/or sell *
+dnl copies of the Software, and to permit persons to whom the Software is *
+dnl furnished to do so, subject to the following conditions: *
+dnl *
+dnl The above copyright notice and this permission notice shall be included *
+dnl in all copies or substantial portions of the Software. *
+dnl *
+dnl THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS *
+dnl OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *
+dnl MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. *
+dnl IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, *
+dnl DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR *
+dnl OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR *
+dnl THE USE OR OTHER DEALINGS IN THE SOFTWARE. *
+dnl *
+dnl Except as contained in this notice, the name(s) of the above copyright *
+dnl holders shall not be used in advertising or otherwise to promote the *
+dnl sale, use or other dealings in this Software without prior written *
+dnl authorization. *
+dnl***************************************************************************
+dnl
+dnl $Id: html.m4,v 1.3 2007/09/01 23:59:59 tom Exp $
+define(`ANCHORIDX',`0')dnl
+define(`MANPAGE',`define(`MANPG',$1)dnl
+|=====================================================================
+ -- | Man page <A HREF="../man/MANPG.html">MANPG</A>
+ -- |=====================================================================')dnl
+define(`ANCHOR',`define(`ANCHORIDX',incr(ANCHORIDX))dnl
+`#'1A NAME="AFU`_'ANCHORIDX"`#'2dnl
+define(`CFUNAME',`$1')define(`AFUNAME',`$2')dnl
+|')dnl
+define(`AKA',``AKA': <A HREF="../man/MANPG.html">CFUNAME</A>')dnl
+define(`ALIAS',``AKA': $1')dnl
diff --git a/Ada95/gen/normal.m4 b/Ada95/gen/normal.m4
new file mode 100644
index 0000000..9529976
--- /dev/null
+++ b/Ada95/gen/normal.m4
@@ -0,0 +1,37 @@
+dnl***************************************************************************
+dnl Copyright (c) 1998,2006 Free Software Foundation, Inc. *
+dnl *
+dnl Permission is hereby granted, free of charge, to any person obtaining a *
+dnl copy of this software and associated documentation files (the *
+dnl "Software"), to deal in the Software without restriction, including *
+dnl without limitation the rights to use, copy, modify, merge, publish, *
+dnl distribute, distribute with modifications, sublicense, and/or sell *
+dnl copies of the Software, and to permit persons to whom the Software is *
+dnl furnished to do so, subject to the following conditions: *
+dnl *
+dnl The above copyright notice and this permission notice shall be included *
+dnl in all copies or substantial portions of the Software. *
+dnl *
+dnl THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS *
+dnl OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *
+dnl MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. *
+dnl IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, *
+dnl DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR *
+dnl OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR *
+dnl THE USE OR OTHER DEALINGS IN THE SOFTWARE. *
+dnl *
+dnl Except as contained in this notice, the name(s) of the above copyright *
+dnl holders shall not be used in advertising or otherwise to promote the *
+dnl sale, use or other dealings in this Software without prior written *
+dnl authorization. *
+dnl***************************************************************************
+dnl
+dnl $Id: normal.m4,v 1.2 2006/04/22 23:16:14 tom Exp $
+define(`MANPAGE',`define(`MANPG',$1)dnl
+|=====================================================================
+ -- | Man page MANPG
+ -- |=====================================================================')dnl
+define(`ANCHOR',`define(`CFUNAME',`$1')define(`AFUNAME',`$2')'dnl
+|)dnl
+define(`AKA',``AKA': CFUNAME')dnl
+define(`ALIAS',``AKA': $1')dnl
diff --git a/Ada95/gen/table.m4 b/Ada95/gen/table.m4
new file mode 100644
index 0000000..36b0027
--- /dev/null
+++ b/Ada95/gen/table.m4
@@ -0,0 +1,35 @@
+dnl***************************************************************************
+dnl Copyright (c) 2000,2006 Free Software Foundation, Inc. *
+dnl *
+dnl Permission is hereby granted, free of charge, to any person obtaining a *
+dnl copy of this software and associated documentation files (the *
+dnl "Software"), to deal in the Software without restriction, including *
+dnl without limitation the rights to use, copy, modify, merge, publish, *
+dnl distribute, distribute with modifications, sublicense, and/or sell *
+dnl copies of the Software, and to permit persons to whom the Software is *
+dnl furnished to do so, subject to the following conditions: *
+dnl *
+dnl The above copyright notice and this permission notice shall be included *
+dnl in all copies or substantial portions of the Software. *
+dnl *
+dnl THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS *
+dnl OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *
+dnl MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. *
+dnl IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, *
+dnl DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR *
+dnl OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR *
+dnl THE USE OR OTHER DEALINGS IN THE SOFTWARE. *
+dnl *
+dnl Except as contained in this notice, the name(s) of the above copyright *
+dnl holders shall not be used in advertising or otherwise to promote the *
+dnl sale, use or other dealings in this Software without prior written *
+dnl authorization. *
+dnl***************************************************************************
+dnl
+dnl $Id: table.m4,v 1.2 2006/04/22 23:16:44 tom Exp $
+define(`ANCHORIDX',`0')dnl
+define(`MANPAGE',`define(`MANPG',$1)')dnl
+divert(-1)dnl
+define(`ANCHOR',`divert(0)define(`ANCHORIDX',incr(ANCHORIDX))dnl
+<TR><TD>$1</TD><TD><A HREF="HTMLNAME`#'AFU`_'ANCHORIDX">$2</A></TD><TD><A HREF="../man/MANPG.html">MANPG</A></TD></TR>
+divert(-1)')
diff --git a/Ada95/gen/terminal_interface-curses-aux.ads.m4 b/Ada95/gen/terminal_interface-curses-aux.ads.m4
new file mode 100644
index 0000000..e0c9348
--- /dev/null
+++ b/Ada95/gen/terminal_interface-curses-aux.ads.m4
@@ -0,0 +1,105 @@
+-- -*- ada -*-
+define(`HTMLNAME',`terminal_interface-curses-aux__ads.htm')dnl
+include(M4MACRO)dnl
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Aux --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.16 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+include(`Base_Defs')
+with System;
+with Interfaces.C;
+with Interfaces.C.Strings; use Interfaces.C.Strings;
+with Unchecked_Conversion;
+
+package Terminal_Interface.Curses.Aux is
+ pragma Preelaborate (Terminal_Interface.Curses.Aux);
+
+ use type Interfaces.C.int;
+
+ subtype C_Int is Interfaces.C.int;
+ subtype C_Short is Interfaces.C.short;
+ subtype C_Long_Int is Interfaces.C.long;
+ subtype C_Size_T is Interfaces.C.size_t;
+ subtype C_UInt is Interfaces.C.unsigned;
+ subtype C_ULong is Interfaces.C.unsigned_long;
+ subtype C_Char_Ptr is Interfaces.C.Strings.chars_ptr;
+ type C_Void_Ptr is new System.Address;
+include(`Chtype_Def')
+ -- This is how those constants are defined in ncurses. I see them also
+ -- exactly like this in all ETI implementations I ever tested. So it
+ -- could be that this is quite general, but please check with your curses.
+ -- This is critical, because curses sometime mixes boolean returns with
+ -- returning an error status.
+ Curses_Ok : constant C_Int := CF_CURSES_OK;
+ Curses_Err : constant C_Int := CF_CURSES_ERR;
+
+ Curses_True : constant C_Int := CF_CURSES_TRUE;
+ Curses_False : constant C_Int := CF_CURSES_FALSE;
+
+ -- Eti_Error: type for error codes returned by the menu and form subsystem
+include(`Eti_Defs')
+ procedure Eti_Exception (Code : Eti_Error);
+ -- Dispatch the error code and raise the appropriate exception
+ --
+ --
+ -- Some helpers
+ function Chtype_To_AttrChar is new
+ Unchecked_Conversion (Source => C_Chtype,
+ Target => Attributed_Character);
+ function AttrChar_To_Chtype is new
+ Unchecked_Conversion (Source => Attributed_Character,
+ Target => C_Chtype);
+
+ function AttrChar_To_AttrType is new
+ Unchecked_Conversion (Source => Attributed_Character,
+ Target => C_AttrType);
+
+ function AttrType_To_AttrChar is new
+ Unchecked_Conversion (Source => C_AttrType,
+ Target => Attributed_Character);
+
+ procedure Fill_String (Cp : in chars_ptr;
+ Str : out String);
+ -- Fill the Str parameter with the string denoted by the chars_ptr
+ -- C-Style string.
+
+ function Fill_String (Cp : chars_ptr) return String;
+ -- Same but as function.
+
+end Terminal_Interface.Curses.Aux;
diff --git a/Ada95/gen/terminal_interface-curses-forms-field_types.ads.m4 b/Ada95/gen/terminal_interface-curses-forms-field_types.ads.m4
new file mode 100644
index 0000000..8819844
--- /dev/null
+++ b/Ada95/gen/terminal_interface-curses-forms-field_types.ads.m4
@@ -0,0 +1,238 @@
+-- -*- ada -*-
+define(`HTMLNAME',`terminal_interface-curses-forms-field_user_data__ads.htm')dnl
+include(M4MACRO)dnl
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types --
+-- --
+-- 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.14 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Interfaces.C;
+
+package Terminal_Interface.Curses.Forms.Field_Types is
+ pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types);
+ use type Interfaces.C.int;
+ subtype C_Int is Interfaces.C.int;
+
+ -- MANPAGE(`form_fieldtype.3x')
+
+ type Field_Type is abstract tagged null record;
+ -- Abstract base type for all field types. A concrete field type
+ -- is an extension that adds some data elements describing formats or
+ -- boundary values for the type and validation routines.
+ -- For the builtin low-level fieldtypes, the validation routines are
+ -- already defined by the low-level C library.
+ -- The builtin types like Alpha or AlphaNumeric etc. are defined in
+ -- child packages of this package. You may use one of them as example
+ -- how to create you own child packages for low-level field types that
+ -- you may have already written in C.
+
+ type Field_Type_Access is access all Field_Type'Class;
+
+ -- ANCHOR(`set_field_type()',`Set_Type')
+ procedure Set_Field_Type (Fld : in Field;
+ Fld_Type : in Field_Type) is abstract;
+ -- AKA
+ -- But: we hide the vararg mechanism of the C interface. You always
+ -- have to pass a single Field_Type parameter.
+
+ -- ---------------------------------------------------------------------
+
+ -- MANPAGE(`form_field_validation.3x')
+
+ -- ANCHOR(`field_type()',`Get_Type')
+ function Get_Type (Fld : in Field) return Field_Type_Access;
+ -- AKA
+ -- ALIAS(`field_arg()')
+ -- In Ada95 we can combine these. If you try to retrieve the field type
+ -- that is not defined as extension of the abstract tagged type above,
+ -- you will raise a Form_Exception.
+ -- This is not inlined
+
+ -- +----------------------------------------------------------------------
+ -- | Private Part.
+ -- | Most of this is used by the implementations of the child packages.
+ -- |
+private
+ type Makearg_Function is access
+ function (Args : System.Address) return System.Address;
+ pragma Convention (C, Makearg_Function);
+
+ type Copyarg_Function is access
+ function (Usr : System.Address) return System.Address;
+ pragma Convention (C, Copyarg_Function);
+
+ type Freearg_Function is access
+ procedure (Usr : System.Address);
+ pragma Convention (C, Freearg_Function);
+
+ type Field_Check_Function is access
+ function (Fld : Field; Usr : System.Address) return C_Int;
+ pragma Convention (C, Field_Check_Function);
+
+ type Char_Check_Function is access
+ function (Ch : C_Int; Usr : System.Address) return C_Int;
+ pragma Convention (C, Char_Check_Function);
+
+ type Choice_Function is access
+ function (Fld : Field; Usr : System.Address) return C_Int;
+ pragma Convention (C, Choice_Function);
+
+ -- +----------------------------------------------------------------------
+ -- | This must be in sync with the FIELDTYPE structure in form.h
+ -- |
+ type Low_Level_Field_Type is
+ record
+ Status : Interfaces.C.short;
+ Ref_Count : Interfaces.C.long;
+ Left, Right : System.Address;
+ Makearg : Makearg_Function;
+ Copyarg : Copyarg_Function;
+ Freearg : Freearg_Function;
+ Fcheck : Field_Check_Function;
+ Ccheck : Char_Check_Function;
+ Next, Prev : Choice_Function;
+ end record;
+ pragma Convention (C, Low_Level_Field_Type);
+ type C_Field_Type is access all Low_Level_Field_Type;
+
+ Null_Field_Type : constant C_Field_Type := null;
+
+ -- +----------------------------------------------------------------------
+ -- | This four low-level fieldtypes are the ones associated with
+ -- | fieldtypes handled by this binding. Any other low-level fieldtype
+ -- | will result in a Form_Exception is function Get_Type.
+ -- |
+ M_Generic_Type : C_Field_Type := null;
+ M_Generic_Choice : C_Field_Type := null;
+ M_Builtin_Router : C_Field_Type := null;
+ M_Choice_Router : C_Field_Type := null;
+
+ -- Two wrapper functions to access those low-level fieldtypes defined
+ -- in this package.
+ function C_Builtin_Router return C_Field_Type;
+ function C_Choice_Router return C_Field_Type;
+
+ procedure Wrap_Builtin (Fld : Field;
+ Typ : Field_Type'Class;
+ Cft : C_Field_Type := C_Builtin_Router);
+ -- This procedure has to be called by the Set_Field_Type implementation
+ -- for builtin low-level fieldtypes to replace it by an Ada95
+ -- conformant Field_Type object.
+ -- The parameter Cft must be C_Builtin_Router for regular low-level
+ -- fieldtypes (like TYP_ALPHA or TYP_ALNUM) and C_Choice_Router for
+ -- low-level fieldtypes witch choice functions (like TYP_ENUM).
+ -- Any other value will raise a Form_Exception.
+
+ function Make_Arg (Args : System.Address) return System.Address;
+ pragma Convention (C, Make_Arg);
+ -- This is the Makearg_Function for the internal low-level types
+ -- introduced by this binding.
+
+ function Copy_Arg (Usr : System.Address) return System.Address;
+ pragma Convention (C, Copy_Arg);
+ -- This is the Copyarg_Function for the internal low-level types
+ -- introduced by this binding.
+
+ procedure Free_Arg (Usr : System.Address);
+ pragma Convention (C, Free_Arg);
+ -- This is the Freearg_Function for the internal low-level types
+ -- introduced by this binding.
+
+ function Field_Check_Router (Fld : Field;
+ Usr : System.Address) return C_Int;
+ pragma Convention (C, Field_Check_Router);
+ -- This is the Field_Check_Function for the internal low-level types
+ -- introduced to wrap the low-level types by a Field_Type derived
+ -- type. It routes the call to the corresponding low-level validation
+ -- function.
+
+ function Char_Check_Router (Ch : C_Int;
+ Usr : System.Address) return C_Int;
+ pragma Convention (C, Char_Check_Router);
+ -- This is the Char_Check_Function for the internal low-level types
+ -- introduced to wrap the low-level types by a Field_Type derived
+ -- type. It routes the call to the corresponding low-level validation
+ -- function.
+
+ function Next_Router (Fld : Field;
+ Usr : System.Address) return C_Int;
+ pragma Convention (C, Next_Router);
+ -- This is the Choice_Function for the internal low-level types
+ -- introduced to wrap the low-level types by a Field_Type derived
+ -- type. It routes the call to the corresponding low-level next_choice
+ -- function.
+
+ function Prev_Router (Fld : Field;
+ Usr : System.Address) return C_Int;
+ pragma Convention (C, Prev_Router);
+ -- This is the Choice_Function for the internal low-level types
+ -- introduced to wrap the low-level types by a Field_Type derived
+ -- type. It routes the call to the corresponding low-level prev_choice
+ -- function.
+
+ -- This is the Argument structure maintained by all low-level field types
+ -- introduced by this binding.
+ type Argument is record
+ Typ : Field_Type_Access; -- the Field_Type creating this record
+ Usr : System.Address; -- original arg for builtin low-level types
+ Cft : C_Field_Type; -- the original low-level type
+ end record;
+ type Argument_Access is access all Argument;
+
+ -- +----------------------------------------------------------------------
+ -- |
+ -- | Some Imports of libform routines to deal with low-level fieldtypes.
+ -- |
+ function New_Fieldtype (Fcheck : Field_Check_Function;
+ Ccheck : Char_Check_Function)
+ return C_Field_Type;
+ pragma Import (C, New_Fieldtype, "new_fieldtype");
+
+ function Set_Fieldtype_Arg (Cft : C_Field_Type;
+ Mak : Makearg_Function := Make_Arg'Access;
+ Cop : Copyarg_Function := Copy_Arg'Access;
+ Fre : Freearg_Function := Free_Arg'Access)
+ return C_Int;
+ pragma Import (C, Set_Fieldtype_Arg, "set_fieldtype_arg");
+
+ function Set_Fieldtype_Choice (Cft : C_Field_Type;
+ Next, Prev : Choice_Function)
+ return C_Int;
+ pragma Import (C, Set_Fieldtype_Choice, "set_fieldtype_choice");
+
+end Terminal_Interface.Curses.Forms.Field_Types;
diff --git a/Ada95/gen/terminal_interface-curses-forms-field_user_data.ads.m4 b/Ada95/gen/terminal_interface-curses-forms-field_user_data.ads.m4
new file mode 100644
index 0000000..4139883
--- /dev/null
+++ b/Ada95/gen/terminal_interface-curses-forms-field_user_data.ads.m4
@@ -0,0 +1,70 @@
+-- -*- ada -*-
+define(`HTMLNAME',`terminal_interface-curses-forms-field_user_data__ads.htm')dnl
+include(M4MACRO)dnl
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_User_Data --
+-- --
+-- 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.15 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+
+generic
+ type User is limited private;
+ type User_Access is access User;
+package Terminal_Interface.Curses.Forms.Field_User_Data is
+ pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_User_Data);
+
+ -- MANPAGE(`form_field_userptr.3x')
+
+ -- ANCHOR(`set_field_userptr',`Set_User_Data')
+ procedure Set_User_Data (Fld : in Field;
+ Data : in User_Access);
+ -- AKA
+ pragma Inline (Set_User_Data);
+
+ -- ANCHOR(`field_userptr',`Get_User_Data')
+ procedure Get_User_Data (Fld : in Field;
+ Data : out User_Access);
+ -- AKA
+
+ -- ANCHOR(`field_userptr',`Get_User_Data')
+ function Get_User_Data (Fld : in Field) return User_Access;
+ -- AKA
+ -- Sama as function
+ pragma Inline (Get_User_Data);
+
+end Terminal_Interface.Curses.Forms.Field_User_Data;
diff --git a/Ada95/gen/terminal_interface-curses-forms-form_user_data.ads.m4 b/Ada95/gen/terminal_interface-curses-forms-form_user_data.ads.m4
new file mode 100644
index 0000000..0c4420d
--- /dev/null
+++ b/Ada95/gen/terminal_interface-curses-forms-form_user_data.ads.m4
@@ -0,0 +1,70 @@
+-- -*- ada -*-
+define(`HTMLNAME',`terminal_interface-curses-forms-form_user_data__ads.htm')dnl
+include(M4MACRO)dnl
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Form_User_Data --
+-- --
+-- 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.14 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+
+generic
+ type User is limited private;
+ type User_Access is access User;
+package Terminal_Interface.Curses.Forms.Form_User_Data is
+ pragma Preelaborate (Terminal_Interface.Curses.Forms.Form_User_Data);
+
+ -- MANPAGE(`form_userptr.3x')
+
+ -- ANCHOR(`set_form_userptr',`Set_User_Data')
+ procedure Set_User_Data (Frm : in Form;
+ Data : in User_Access);
+ -- AKA
+ pragma Inline (Set_User_Data);
+
+ -- ANCHOR(`form_userptr',`Get_User_Data')
+ procedure Get_User_Data (Frm : in Form;
+ Data : out User_Access);
+ -- AKA
+
+ -- ANCHOR(`form_userptr',`Get_User_Data')
+ function Get_User_Data (Frm : in Form) return User_Access;
+ -- AKA
+ -- Same as function
+ pragma Inline (Get_User_Data);
+
+end Terminal_Interface.Curses.Forms.Form_User_Data;
diff --git a/Ada95/gen/terminal_interface-curses-forms.ads.m4 b/Ada95/gen/terminal_interface-curses-forms.ads.m4
new file mode 100644
index 0000000..5b75edb
--- /dev/null
+++ b/Ada95/gen/terminal_interface-curses-forms.ads.m4
@@ -0,0 +1,699 @@
+-- -*- ada -*-
+define(`HTMLNAME',`terminal_interface-curses-forms__ads.htm')dnl
+include(M4MACRO)dnl
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Form --
+-- --
+-- 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.29 $
+-- $Date: 2006/06/25 14:30:21 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+include(`Form_Base_Defs')
+with System;
+with Ada.Characters.Latin_1;
+
+package Terminal_Interface.Curses.Forms is
+ pragma Preelaborate (Terminal_Interface.Curses.Forms);
+include(`Form_Linker_Options')dnl
+include(`Linker_Options')
+ Space : Character renames Ada.Characters.Latin_1.Space;
+
+ type Field is private;
+ type Form is private;
+
+ Null_Field : constant Field;
+ Null_Form : constant Form;
+
+ type Field_Justification is (None,
+ Left,
+ Center,
+ Right);
+
+ pragma Warnings (Off);
+include(`Field_Rep')Dnl
+
+ pragma Warnings (On);
+
+ function Default_Field_Options return Field_Option_Set;
+ -- The initial defaults for the field options.
+ pragma Inline (Default_Field_Options);
+
+ pragma Warnings (Off);
+include(`Form_Opt_Rep')Dnl
+
+ pragma Warnings (On);
+
+ function Default_Form_Options return Form_Option_Set;
+ -- The initial defaults for the form options.
+ pragma Inline (Default_Form_Options);
+
+ type Buffer_Number is new Natural;
+
+ type Field_Array is array (Positive range <>) of aliased Field;
+ pragma Convention (C, Field_Array);
+
+ type Field_Array_Access is access Field_Array;
+
+ procedure Free (FA : in out Field_Array_Access;
+ Free_Fields : in Boolean := False);
+ -- Release the memory for an allocated field array
+ -- If Free_Fields is True, call Delete() for all the fields in
+ -- the array.
+
+ subtype Form_Request_Code is Key_Code range (Key_Max + 1) .. (Key_Max + 57);
+
+ -- The prefix F_ stands for "Form Request"
+ F_Next_Page : constant Form_Request_Code := Key_Max + 1;
+ F_Previous_Page : constant Form_Request_Code := Key_Max + 2;
+ F_First_Page : constant Form_Request_Code := Key_Max + 3;
+ F_Last_Page : constant Form_Request_Code := Key_Max + 4;
+
+ F_Next_Field : constant Form_Request_Code := Key_Max + 5;
+ F_Previous_Field : constant Form_Request_Code := Key_Max + 6;
+ F_First_Field : constant Form_Request_Code := Key_Max + 7;
+ F_Last_Field : constant Form_Request_Code := Key_Max + 8;
+ F_Sorted_Next_Field : constant Form_Request_Code := Key_Max + 9;
+ F_Sorted_Previous_Field : constant Form_Request_Code := Key_Max + 10;
+ F_Sorted_First_Field : constant Form_Request_Code := Key_Max + 11;
+ F_Sorted_Last_Field : constant Form_Request_Code := Key_Max + 12;
+ F_Left_Field : constant Form_Request_Code := Key_Max + 13;
+ F_Right_Field : constant Form_Request_Code := Key_Max + 14;
+ F_Up_Field : constant Form_Request_Code := Key_Max + 15;
+ F_Down_Field : constant Form_Request_Code := Key_Max + 16;
+
+ F_Next_Char : constant Form_Request_Code := Key_Max + 17;
+ F_Previous_Char : constant Form_Request_Code := Key_Max + 18;
+ F_Next_Line : constant Form_Request_Code := Key_Max + 19;
+ F_Previous_Line : constant Form_Request_Code := Key_Max + 20;
+ F_Next_Word : constant Form_Request_Code := Key_Max + 21;
+ F_Previous_Word : constant Form_Request_Code := Key_Max + 22;
+ F_Begin_Field : constant Form_Request_Code := Key_Max + 23;
+ F_End_Field : constant Form_Request_Code := Key_Max + 24;
+ F_Begin_Line : constant Form_Request_Code := Key_Max + 25;
+ F_End_Line : constant Form_Request_Code := Key_Max + 26;
+ F_Left_Char : constant Form_Request_Code := Key_Max + 27;
+ F_Right_Char : constant Form_Request_Code := Key_Max + 28;
+ F_Up_Char : constant Form_Request_Code := Key_Max + 29;
+ F_Down_Char : constant Form_Request_Code := Key_Max + 30;
+
+ F_New_Line : constant Form_Request_Code := Key_Max + 31;
+ F_Insert_Char : constant Form_Request_Code := Key_Max + 32;
+ F_Insert_Line : constant Form_Request_Code := Key_Max + 33;
+ F_Delete_Char : constant Form_Request_Code := Key_Max + 34;
+ F_Delete_Previous : constant Form_Request_Code := Key_Max + 35;
+ F_Delete_Line : constant Form_Request_Code := Key_Max + 36;
+ F_Delete_Word : constant Form_Request_Code := Key_Max + 37;
+ F_Clear_EOL : constant Form_Request_Code := Key_Max + 38;
+ F_Clear_EOF : constant Form_Request_Code := Key_Max + 39;
+ F_Clear_Field : constant Form_Request_Code := Key_Max + 40;
+ F_Overlay_Mode : constant Form_Request_Code := Key_Max + 41;
+ F_Insert_Mode : constant Form_Request_Code := Key_Max + 42;
+
+ -- Vertical Scrolling
+ F_ScrollForward_Line : constant Form_Request_Code := Key_Max + 43;
+ F_ScrollBackward_Line : constant Form_Request_Code := Key_Max + 44;
+ F_ScrollForward_Page : constant Form_Request_Code := Key_Max + 45;
+ F_ScrollBackward_Page : constant Form_Request_Code := Key_Max + 46;
+ F_ScrollForward_HalfPage : constant Form_Request_Code := Key_Max + 47;
+ F_ScrollBackward_HalfPage : constant Form_Request_Code := Key_Max + 48;
+
+ -- Horizontal Scrolling
+ F_HScrollForward_Char : constant Form_Request_Code := Key_Max + 49;
+ F_HScrollBackward_Char : constant Form_Request_Code := Key_Max + 50;
+ F_HScrollForward_Line : constant Form_Request_Code := Key_Max + 51;
+ F_HScrollBackward_Line : constant Form_Request_Code := Key_Max + 52;
+ F_HScrollForward_HalfLine : constant Form_Request_Code := Key_Max + 53;
+ F_HScrollBackward_HalfLine : constant Form_Request_Code := Key_Max + 54;
+
+ F_Validate_Field : constant Form_Request_Code := Key_Max + 55;
+ F_Next_Choice : constant Form_Request_Code := Key_Max + 56;
+ F_Previous_Choice : constant Form_Request_Code := Key_Max + 57;
+
+ -- For those who like the old 'C' style request names
+ REQ_NEXT_PAGE : Form_Request_Code renames F_Next_Page;
+ REQ_PREV_PAGE : Form_Request_Code renames F_Previous_Page;
+ REQ_FIRST_PAGE : Form_Request_Code renames F_First_Page;
+ REQ_LAST_PAGE : Form_Request_Code renames F_Last_Page;
+
+ REQ_NEXT_FIELD : Form_Request_Code renames F_Next_Field;
+ REQ_PREV_FIELD : Form_Request_Code renames F_Previous_Field;
+ REQ_FIRST_FIELD : Form_Request_Code renames F_First_Field;
+ REQ_LAST_FIELD : Form_Request_Code renames F_Last_Field;
+ REQ_SNEXT_FIELD : Form_Request_Code renames F_Sorted_Next_Field;
+ REQ_SPREV_FIELD : Form_Request_Code renames F_Sorted_Previous_Field;
+ REQ_SFIRST_FIELD : Form_Request_Code renames F_Sorted_First_Field;
+ REQ_SLAST_FIELD : Form_Request_Code renames F_Sorted_Last_Field;
+ REQ_LEFT_FIELD : Form_Request_Code renames F_Left_Field;
+ REQ_RIGHT_FIELD : Form_Request_Code renames F_Right_Field;
+ REQ_UP_FIELD : Form_Request_Code renames F_Up_Field;
+ REQ_DOWN_FIELD : Form_Request_Code renames F_Down_Field;
+
+ REQ_NEXT_CHAR : Form_Request_Code renames F_Next_Char;
+ REQ_PREV_CHAR : Form_Request_Code renames F_Previous_Char;
+ REQ_NEXT_LINE : Form_Request_Code renames F_Next_Line;
+ REQ_PREV_LINE : Form_Request_Code renames F_Previous_Line;
+ REQ_NEXT_WORD : Form_Request_Code renames F_Next_Word;
+ REQ_PREV_WORD : Form_Request_Code renames F_Previous_Word;
+ REQ_BEG_FIELD : Form_Request_Code renames F_Begin_Field;
+ REQ_END_FIELD : Form_Request_Code renames F_End_Field;
+ REQ_BEG_LINE : Form_Request_Code renames F_Begin_Line;
+ REQ_END_LINE : Form_Request_Code renames F_End_Line;
+ REQ_LEFT_CHAR : Form_Request_Code renames F_Left_Char;
+ REQ_RIGHT_CHAR : Form_Request_Code renames F_Right_Char;
+ REQ_UP_CHAR : Form_Request_Code renames F_Up_Char;
+ REQ_DOWN_CHAR : Form_Request_Code renames F_Down_Char;
+
+ REQ_NEW_LINE : Form_Request_Code renames F_New_Line;
+ REQ_INS_CHAR : Form_Request_Code renames F_Insert_Char;
+ REQ_INS_LINE : Form_Request_Code renames F_Insert_Line;
+ REQ_DEL_CHAR : Form_Request_Code renames F_Delete_Char;
+ REQ_DEL_PREV : Form_Request_Code renames F_Delete_Previous;
+ REQ_DEL_LINE : Form_Request_Code renames F_Delete_Line;
+ REQ_DEL_WORD : Form_Request_Code renames F_Delete_Word;
+ REQ_CLR_EOL : Form_Request_Code renames F_Clear_EOL;
+ REQ_CLR_EOF : Form_Request_Code renames F_Clear_EOF;
+ REQ_CLR_FIELD : Form_Request_Code renames F_Clear_Field;
+ REQ_OVL_MODE : Form_Request_Code renames F_Overlay_Mode;
+ REQ_INS_MODE : Form_Request_Code renames F_Insert_Mode;
+
+ REQ_SCR_FLINE : Form_Request_Code renames F_ScrollForward_Line;
+ REQ_SCR_BLINE : Form_Request_Code renames F_ScrollBackward_Line;
+ REQ_SCR_FPAGE : Form_Request_Code renames F_ScrollForward_Page;
+ REQ_SCR_BPAGE : Form_Request_Code renames F_ScrollBackward_Page;
+ REQ_SCR_FHPAGE : Form_Request_Code renames F_ScrollForward_HalfPage;
+ REQ_SCR_BHPAGE : Form_Request_Code renames F_ScrollBackward_HalfPage;
+
+ REQ_SCR_FCHAR : Form_Request_Code renames F_HScrollForward_Char;
+ REQ_SCR_BCHAR : Form_Request_Code renames F_HScrollBackward_Char;
+ REQ_SCR_HFLINE : Form_Request_Code renames F_HScrollForward_Line;
+ REQ_SCR_HBLINE : Form_Request_Code renames F_HScrollBackward_Line;
+ REQ_SCR_HFHALF : Form_Request_Code renames F_HScrollForward_HalfLine;
+ REQ_SCR_HBHALF : Form_Request_Code renames F_HScrollBackward_HalfLine;
+
+ REQ_VALIDATION : Form_Request_Code renames F_Validate_Field;
+ REQ_NEXT_CHOICE : Form_Request_Code renames F_Next_Choice;
+ REQ_PREV_CHOICE : Form_Request_Code renames F_Previous_Choice;
+
+ procedure Request_Name (Key : in Form_Request_Code;
+ Name : out String);
+
+ function Request_Name (Key : Form_Request_Code) return String;
+ -- Same as function
+ pragma Inline (Request_Name);
+
+ ------------------
+ -- Exceptions --
+ ------------------
+ Form_Exception : exception;
+
+ -- MANPAGE(`form_field_new.3x')
+
+ -- ANCHOR(`new_field()',`Create')
+ 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;
+ -- AKA
+ -- An overloaded Create is defined later. Pragma Inline appears there.
+
+ -- ANCHOR(`new_field()',`New_Field')
+ function New_Field (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 renames Create;
+ -- AKA
+ pragma Inline (New_Field);
+
+ -- ANCHOR(`free_field()',`Delete')
+ procedure Delete (Fld : in out Field);
+ -- AKA
+ -- Reset Fld to Null_Field
+ -- An overloaded Delete is defined later. Pragma Inline appears there.
+
+ -- ANCHOR(`dup_field()',`Duplicate')
+ function Duplicate (Fld : Field;
+ Top : Line_Position;
+ Left : Column_Position) return Field;
+ -- AKA
+ pragma Inline (Duplicate);
+
+ -- ANCHOR(`link_field()',`Link')
+ function Link (Fld : Field;
+ Top : Line_Position;
+ Left : Column_Position) return Field;
+ -- AKA
+ pragma Inline (Link);
+
+ -- MANPAGE(`form_field_just.3x')
+
+ -- ANCHOR(`set_field_just()',`Set_Justification')
+ procedure Set_Justification (Fld : in Field;
+ Just : in Field_Justification := None);
+ -- AKA
+ pragma Inline (Set_Justification);
+
+ -- ANCHOR(`field_just()',`Get_Justification')
+ function Get_Justification (Fld : Field) return Field_Justification;
+ -- AKA
+ pragma Inline (Get_Justification);
+
+ -- MANPAGE(`form_field_buffer.3x')
+
+ -- ANCHOR(`set_field_buffer()',`Set_Buffer')
+ procedure Set_Buffer
+ (Fld : in Field;
+ Buffer : in Buffer_Number := Buffer_Number'First;
+ Str : in String);
+ -- AKA
+ -- Not inlined
+
+ -- ANCHOR(`field_buffer()',`Get_Buffer')
+ procedure Get_Buffer
+ (Fld : in Field;
+ Buffer : in Buffer_Number := Buffer_Number'First;
+ Str : out String);
+ -- AKA
+
+ function Get_Buffer
+ (Fld : in Field;
+ Buffer : in Buffer_Number := Buffer_Number'First) return String;
+ -- AKA
+ -- Same but as function
+ pragma Inline (Get_Buffer);
+
+ -- ANCHOR(`set_field_status()',`Set_Status')
+ procedure Set_Status (Fld : in Field;
+ Status : in Boolean := True);
+ -- AKA
+ pragma Inline (Set_Status);
+
+ -- ANCHOR(`field_status()',`Changed')
+ function Changed (Fld : Field) return Boolean;
+ -- AKA
+ pragma Inline (Changed);
+
+ -- ANCHOR(`set_field_max()',`Set_Maximum_Size')
+ procedure Set_Maximum_Size (Fld : in Field;
+ Max : in Natural := 0);
+ -- AKA
+ pragma Inline (Set_Maximum_Size);
+
+ -- MANPAGE(`form_field_opts.3x')
+
+ -- ANCHOR(`set_field_opts()',`Set_Options')
+ procedure Set_Options (Fld : in Field;
+ Options : in Field_Option_Set);
+ -- AKA
+ -- An overloaded version is defined later. Pragma Inline appears there
+
+ -- ANCHOR(`field_opts_on()',`Switch_Options')
+ procedure Switch_Options (Fld : in Field;
+ Options : in Field_Option_Set;
+ On : Boolean := True);
+ -- AKA
+ -- ALIAS(`field_opts_off()')
+ -- An overloaded version is defined later. Pragma Inline appears there
+
+ -- ANCHOR(`field_opts()',`Get_Options')
+ procedure Get_Options (Fld : in Field;
+ Options : out Field_Option_Set);
+ -- AKA
+
+ -- ANCHOR(`field_opts()',`Get_Options')
+ function Get_Options (Fld : Field := Null_Field)
+ return Field_Option_Set;
+ -- AKA
+ -- An overloaded version is defined later. Pragma Inline appears there
+
+ -- MANPAGE(`form_field_attributes.3x')
+
+ -- ANCHOR(`set_field_fore()',`Set_Foreground')
+ procedure Set_Foreground
+ (Fld : in Field;
+ Fore : in Character_Attribute_Set := Normal_Video;
+ Color : in Color_Pair := Color_Pair'First);
+ -- AKA
+ pragma Inline (Set_Foreground);
+
+ -- ANCHOR(`field_fore()',`Foreground')
+ procedure Foreground (Fld : in Field;
+ Fore : out Character_Attribute_Set);
+ -- AKA
+
+ -- ANCHOR(`field_fore()',`Foreground')
+ procedure Foreground (Fld : in Field;
+ Fore : out Character_Attribute_Set;
+ Color : out Color_Pair);
+ -- AKA
+ pragma Inline (Foreground);
+
+ -- ANCHOR(`set_field_back()',`Set_Background')
+ procedure Set_Background
+ (Fld : in Field;
+ Back : in Character_Attribute_Set := Normal_Video;
+ Color : in Color_Pair := Color_Pair'First);
+ -- AKA
+ pragma Inline (Set_Background);
+
+ -- ANCHOR(`field_back()',`Background')
+ procedure Background (Fld : in Field;
+ Back : out Character_Attribute_Set);
+ -- AKA
+
+ -- ANCHOR(`field_back()',`Background')
+ procedure Background (Fld : in Field;
+ Back : out Character_Attribute_Set;
+ Color : out Color_Pair);
+ -- AKA
+ pragma Inline (Background);
+
+ -- ANCHOR(`set_field_pad()',`Set_Pad_Character')
+ procedure Set_Pad_Character (Fld : in Field;
+ Pad : in Character := Space);
+ -- AKA
+ pragma Inline (Set_Pad_Character);
+
+ -- ANCHOR(`field_pad()',`Pad_Character')
+ procedure Pad_Character (Fld : in Field;
+ Pad : out Character);
+ -- AKA
+ pragma Inline (Pad_Character);
+
+ -- MANPAGE(`form_field_info.3x')
+
+ -- ANCHOR(`field_info()',`Info')
+ procedure Info (Fld : in Field;
+ Lines : out Line_Count;
+ Columns : out Column_Count;
+ First_Row : out Line_Position;
+ First_Column : out Column_Position;
+ Off_Screen : out Natural;
+ Additional_Buffers : out Buffer_Number);
+ -- AKA
+ pragma Inline (Info);
+
+ -- ANCHOR(`dynamic_field_info()',`Dynamic_Info')
+ procedure Dynamic_Info (Fld : in Field;
+ Lines : out Line_Count;
+ Columns : out Column_Count;
+ Max : out Natural);
+ -- AKA
+ pragma Inline (Dynamic_Info);
+
+ -- MANPAGE(`form_win.3x')
+
+ -- ANCHOR(`set_form_win()',`Set_Window')
+ procedure Set_Window (Frm : in Form;
+ Win : in Window);
+ -- AKA
+ pragma Inline (Set_Window);
+
+ -- ANCHOR(`form_win()',`Get_Window')
+ function Get_Window (Frm : Form) return Window;
+ -- AKA
+ pragma Inline (Get_Window);
+
+ -- ANCHOR(`set_form_sub()',`Set_Sub_Window')
+ procedure Set_Sub_Window (Frm : in Form;
+ Win : in Window);
+ -- AKA
+ pragma Inline (Set_Sub_Window);
+
+ -- ANCHOR(`form_sub()',`Get_Sub_Window')
+ function Get_Sub_Window (Frm : Form) return Window;
+ -- AKA
+ pragma Inline (Get_Sub_Window);
+
+ -- ANCHOR(`scale_form()',`Scale')
+ procedure Scale (Frm : in Form;
+ Lines : out Line_Count;
+ Columns : out Column_Count);
+ -- AKA
+ pragma Inline (Scale);
+
+ -- MANPAGE(`form_hook.3x')
+
+ type Form_Hook_Function is access procedure (Frm : in Form);
+ pragma Convention (C, Form_Hook_Function);
+
+ -- ANCHOR(`set_field_init()',`Set_Field_Init_Hook')
+ procedure Set_Field_Init_Hook (Frm : in Form;
+ Proc : in Form_Hook_Function);
+ -- AKA
+ pragma Inline (Set_Field_Init_Hook);
+
+ -- ANCHOR(`set_field_term()',`Set_Field_Term_Hook')
+ procedure Set_Field_Term_Hook (Frm : in Form;
+ Proc : in Form_Hook_Function);
+ -- AKA
+ pragma Inline (Set_Field_Term_Hook);
+
+ -- ANCHOR(`set_form_init()',`Set_Form_Init_Hook')
+ procedure Set_Form_Init_Hook (Frm : in Form;
+ Proc : in Form_Hook_Function);
+ -- AKA
+ pragma Inline (Set_Form_Init_Hook);
+
+ -- ANCHOR(`set_form_term()',`Set_Form_Term_Hook')
+ procedure Set_Form_Term_Hook (Frm : in Form;
+ Proc : in Form_Hook_Function);
+ -- AKA
+ pragma Inline (Set_Form_Term_Hook);
+
+ -- ANCHOR(`field_init()',`Get_Field_Init_Hook')
+ function Get_Field_Init_Hook (Frm : Form) return Form_Hook_Function;
+ -- AKA
+ pragma Import (C, Get_Field_Init_Hook, "field_init");
+
+ -- ANCHOR(`field_term()',`Get_Field_Term_Hook')
+ function Get_Field_Term_Hook (Frm : Form) return Form_Hook_Function;
+ -- AKA
+ pragma Import (C, Get_Field_Term_Hook, "field_term");
+
+ -- ANCHOR(`form_init()',`Get_Form_Init_Hook')
+ function Get_Form_Init_Hook (Frm : Form) return Form_Hook_Function;
+ -- AKA
+ pragma Import (C, Get_Form_Init_Hook, "form_init");
+
+ -- ANCHOR(`form_term()',`Get_Form_Term_Hook')
+ function Get_Form_Term_Hook (Frm : Form) return Form_Hook_Function;
+ -- AKA
+ pragma Import (C, Get_Form_Term_Hook, "form_term");
+
+ -- MANPAGE(`form_field.3x')
+
+ -- ANCHOR(`set_form_fields()',`Redefine')
+ procedure Redefine (Frm : in Form;
+ Flds : in Field_Array_Access);
+ -- AKA
+ pragma Inline (Redefine);
+
+ -- ANCHOR(`set_form_fields()',`Set_Fields')
+ procedure Set_Fields (Frm : in Form;
+ Flds : in Field_Array_Access) renames Redefine;
+ -- AKA
+ -- pragma Inline (Set_Fields);
+
+ -- ANCHOR(`form_fields()',`Fields')
+ function Fields (Frm : Form;
+ Index : Positive) return Field;
+ -- AKA
+ pragma Inline (Fields);
+
+ -- ANCHOR(`field_count()',`Field_Count')
+ function Field_Count (Frm : Form) return Natural;
+ -- AKA
+ pragma Inline (Field_Count);
+
+ -- ANCHOR(`move_field()',`Move')
+ procedure Move (Fld : in Field;
+ Line : in Line_Position;
+ Column : in Column_Position);
+ -- AKA
+ pragma Inline (Move);
+
+ -- MANPAGE(`form_new.3x')
+
+ -- ANCHOR(`new_form()',`Create')
+ function Create (Fields : Field_Array_Access) return Form;
+ -- AKA
+ pragma Inline (Create);
+
+ -- ANCHOR(`new_form()',`New_Form')
+ function New_Form (Fields : Field_Array_Access) return Form
+ renames Create;
+ -- AKA
+ -- pragma Inline (New_Form);
+
+ -- ANCHOR(`free_form()',`Delete')
+ procedure Delete (Frm : in out Form);
+ -- AKA
+ -- Reset Frm to Null_Form
+ pragma Inline (Delete);
+
+ -- MANPAGE(`form_opts.3x')
+
+ -- ANCHOR(`set_form_opts()',`Set_Options')
+ procedure Set_Options (Frm : in Form;
+ Options : in Form_Option_Set);
+ -- AKA
+ pragma Inline (Set_Options);
+
+ -- ANCHOR(`form_opts_on()',`Switch_Options')
+ procedure Switch_Options (Frm : in Form;
+ Options : in Form_Option_Set;
+ On : Boolean := True);
+ -- AKA
+ -- ALIAS(`form_opts_off()')
+ pragma Inline (Switch_Options);
+
+ -- ANCHOR(`form_opts()',`Get_Options')
+ procedure Get_Options (Frm : in Form;
+ Options : out Form_Option_Set);
+ -- AKA
+
+ -- ANCHOR(`form_opts()',`Get_Options')
+ function Get_Options (Frm : Form := Null_Form) return Form_Option_Set;
+ -- AKA
+ pragma Inline (Get_Options);
+
+ -- MANPAGE(`form_post.3x')
+
+ -- ANCHOR(`post_form()',`Post')
+ procedure Post (Frm : in Form;
+ Post : in Boolean := True);
+ -- AKA
+ -- ALIAS(`unpost_form()')
+ pragma Inline (Post);
+
+ -- MANPAGE(`form_cursor.3x')
+
+ -- ANCHOR(`pos_form_cursor()',`Position_Cursor')
+ procedure Position_Cursor (Frm : Form);
+ -- AKA
+ pragma Inline (Position_Cursor);
+
+ -- MANPAGE(`form_data.3x')
+
+ -- ANCHOR(`data_ahead()',`Data_Ahead')
+ function Data_Ahead (Frm : Form) return Boolean;
+ -- AKA
+ pragma Inline (Data_Ahead);
+
+ -- ANCHOR(`data_behind()',`Data_Behind')
+ function Data_Behind (Frm : Form) return Boolean;
+ -- AKA
+ pragma Inline (Data_Behind);
+
+ -- MANPAGE(`form_driver.3x')
+
+ type Driver_Result is (Form_Ok,
+ Request_Denied,
+ Unknown_Request,
+ Invalid_Field);
+
+ -- ANCHOR(`form_driver()',`Driver')
+ function Driver (Frm : Form;
+ Key : Key_Code) return Driver_Result;
+ -- AKA
+ -- Driver not inlined
+
+ -- MANPAGE(`form_page.3x')
+
+ type Page_Number is new Natural;
+
+ -- ANCHOR(`set_current_field()',`Set_Current')
+ procedure Set_Current (Frm : in Form;
+ Fld : in Field);
+ -- AKA
+ pragma Inline (Set_Current);
+
+ -- ANCHOR(`current_field()',`Current')
+ function Current (Frm : in Form) return Field;
+ -- AKA
+ pragma Inline (Current);
+
+ -- ANCHOR(`set_form_page()',`Set_Page')
+ procedure Set_Page (Frm : in Form;
+ Page : in Page_Number := Page_Number'First);
+ -- AKA
+ pragma Inline (Set_Page);
+
+ -- ANCHOR(`form_page()',`Page')
+ function Page (Frm : Form) return Page_Number;
+ -- AKA
+ pragma Inline (Page);
+
+ -- ANCHOR(`field_index()',`Get_Index')
+ function Get_Index (Fld : Field) return Positive;
+ -- AKA
+ -- Please note that in this binding we start the numbering of fields
+ -- with 1. So this is number is one more than you get from the low
+ -- level call.
+ pragma Inline (Get_Index);
+
+ -- MANPAGE(`form_new_page.3x')
+
+ -- ANCHOR(`set_new_page()',`Set_New_Page')
+ procedure Set_New_Page (Fld : in Field;
+ New_Page : in Boolean := True);
+ -- AKA
+ pragma Inline (Set_New_Page);
+
+ -- ANCHOR(`new_page()',`Is_New_Page')
+ function Is_New_Page (Fld : Field) return Boolean;
+ -- AKA
+ pragma Inline (Is_New_Page);
+
+ -- MANPAGE(`form_requestname.3x')
+ -- Not Implemented: form_request_name, form_request_by_name
+
+------------------------------------------------------------------------------
+private
+ type Field is new System.Storage_Elements.Integer_Address;
+ type Form is new System.Storage_Elements.Integer_Address;
+
+ Null_Field : constant Field := 0;
+ Null_Form : constant Form := 0;
+
+end Terminal_Interface.Curses.Forms;
diff --git a/Ada95/gen/terminal_interface-curses-menus-item_user_data.ads.m4 b/Ada95/gen/terminal_interface-curses-menus-item_user_data.ads.m4
new file mode 100644
index 0000000..14b2466
--- /dev/null
+++ b/Ada95/gen/terminal_interface-curses-menus-item_user_data.ads.m4
@@ -0,0 +1,75 @@
+-- -*- ada -*-
+define(`HTMLNAME',`terminal_interface-curses-menus-item_user_data__ads.htm')dnl
+include(M4MACRO)dnl
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Menus.Item_User_Data --
+-- --
+-- 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.16 $
+-- $Date: 2006/06/25 14:30:22 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+
+generic
+ type User is limited private;
+ type User_Access is access User;
+package Terminal_Interface.Curses.Menus.Item_User_Data is
+ pragma Preelaborate (Terminal_Interface.Curses.Menus.Item_User_Data);
+
+ -- The binding uses the same user pointer for menu items
+ -- as the low level C implementation. So you can safely
+ -- read or write the user pointer also with the C routines
+ --
+ -- MANPAGE(`mitem_userptr.3x')
+
+ -- ANCHOR(`set_item_userptr',`Set_User_Data')
+ procedure Set_User_Data (Itm : in Item;
+ Data : in User_Access);
+ -- AKA
+ pragma Inline (Set_User_Data);
+
+ -- ANCHOR(`item_userptr',`Get_User_Data')
+ procedure Get_User_Data (Itm : in Item;
+ Data : out User_Access);
+ -- AKA
+
+ -- ANCHOR(`item_userptr',`Get_User_Data')
+ function Get_User_Data (Itm : in Item) return User_Access;
+ -- AKA
+ -- Same as function
+ pragma Inline (Get_User_Data);
+
+end Terminal_Interface.Curses.Menus.Item_User_Data;
diff --git a/Ada95/gen/terminal_interface-curses-menus-menu_user_data.ads.m4 b/Ada95/gen/terminal_interface-curses-menus-menu_user_data.ads.m4
new file mode 100644
index 0000000..696149b
--- /dev/null
+++ b/Ada95/gen/terminal_interface-curses-menus-menu_user_data.ads.m4
@@ -0,0 +1,70 @@
+-- -*- ada -*-
+define(`HTMLNAME',`terminal_interface-curses-menus-menu_user_data__ads.htm')dnl
+include(M4MACRO)dnl
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Menus.Menu_User_Data --
+-- --
+-- 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.14 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+
+generic
+ type User is limited private;
+ type User_Access is access User;
+package Terminal_Interface.Curses.Menus.Menu_User_Data is
+ pragma Preelaborate (Terminal_Interface.Curses.Menus.Menu_User_Data);
+
+ -- MANPAGE(`menu_userptr.3x')
+
+ -- ANCHOR(`set_menu_userptr',`Set_User_Data')
+ procedure Set_User_Data (Men : in Menu;
+ Data : in User_Access);
+ -- AKA
+ pragma Inline (Set_User_Data);
+
+ -- ANCHOR(`menu_userptr',`Get_User_Data')
+ procedure Get_User_Data (Men : in Menu;
+ Data : out User_Access);
+ -- AKA
+
+ -- ANCHOR(`menu_userptr',`Get_User_Data')
+ function Get_User_Data (Men : in Menu) return User_Access;
+ -- AKA
+ -- Same as function
+ pragma Inline (Get_User_Data);
+
+end Terminal_Interface.Curses.Menus.Menu_User_Data;
diff --git a/Ada95/gen/terminal_interface-curses-menus.ads.m4 b/Ada95/gen/terminal_interface-curses-menus.ads.m4
new file mode 100644
index 0000000..17993e1
--- /dev/null
+++ b/Ada95/gen/terminal_interface-curses-menus.ads.m4
@@ -0,0 +1,604 @@
+-- -*- ada -*-
+define(`HTMLNAME',`terminal_interface-curses-menus__ads.htm')dnl
+include(M4MACRO)dnl
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Menu --
+-- --
+-- 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.27 $
+-- $Date: 2007/05/05 20:20:52 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+include(`Menu_Base_Defs')
+with System;
+with Ada.Characters.Latin_1;
+
+package Terminal_Interface.Curses.Menus is
+ pragma Preelaborate (Terminal_Interface.Curses.Menus);
+include(`Menu_Linker_Options')dnl
+include(`Linker_Options')
+ Space : Character renames Ada.Characters.Latin_1.Space;
+
+ type Item is private;
+ type Menu is private;
+
+ ---------------------------
+ -- Interface constants --
+ ---------------------------
+ Null_Item : constant Item;
+ Null_Menu : constant Menu;
+
+ subtype Menu_Request_Code is Key_Code
+ range (Key_Max + 1) .. (Key_Max + 17);
+
+ -- The prefix M_ stands for "Menu Request"
+ M_Left_Item : constant Menu_Request_Code := Key_Max + 1;
+ M_Right_Item : constant Menu_Request_Code := Key_Max + 2;
+ M_Up_Item : constant Menu_Request_Code := Key_Max + 3;
+ M_Down_Item : constant Menu_Request_Code := Key_Max + 4;
+ M_ScrollUp_Line : constant Menu_Request_Code := Key_Max + 5;
+ M_ScrollDown_Line : constant Menu_Request_Code := Key_Max + 6;
+ M_ScrollDown_Page : constant Menu_Request_Code := Key_Max + 7;
+ M_ScrollUp_Page : constant Menu_Request_Code := Key_Max + 8;
+ M_First_Item : constant Menu_Request_Code := Key_Max + 9;
+ M_Last_Item : constant Menu_Request_Code := Key_Max + 10;
+ M_Next_Item : constant Menu_Request_Code := Key_Max + 11;
+ M_Previous_Item : constant Menu_Request_Code := Key_Max + 12;
+ M_Toggle_Item : constant Menu_Request_Code := Key_Max + 13;
+ M_Clear_Pattern : constant Menu_Request_Code := Key_Max + 14;
+ M_Back_Pattern : constant Menu_Request_Code := Key_Max + 15;
+ M_Next_Match : constant Menu_Request_Code := Key_Max + 16;
+ M_Previous_Match : constant Menu_Request_Code := Key_Max + 17;
+
+ -- For those who like the old 'C' names for the request codes
+ REQ_LEFT_ITEM : Menu_Request_Code renames M_Left_Item;
+ REQ_RIGHT_ITEM : Menu_Request_Code renames M_Right_Item;
+ REQ_UP_ITEM : Menu_Request_Code renames M_Up_Item;
+ REQ_DOWN_ITEM : Menu_Request_Code renames M_Down_Item;
+ REQ_SCR_ULINE : Menu_Request_Code renames M_ScrollUp_Line;
+ REQ_SCR_DLINE : Menu_Request_Code renames M_ScrollDown_Line;
+ REQ_SCR_DPAGE : Menu_Request_Code renames M_ScrollDown_Page;
+ REQ_SCR_UPAGE : Menu_Request_Code renames M_ScrollUp_Page;
+ REQ_FIRST_ITEM : Menu_Request_Code renames M_First_Item;
+ REQ_LAST_ITEM : Menu_Request_Code renames M_Last_Item;
+ REQ_NEXT_ITEM : Menu_Request_Code renames M_Next_Item;
+ REQ_PREV_ITEM : Menu_Request_Code renames M_Previous_Item;
+ REQ_TOGGLE_ITEM : Menu_Request_Code renames M_Toggle_Item;
+ REQ_CLEAR_PATTERN : Menu_Request_Code renames M_Clear_Pattern;
+ REQ_BACK_PATTERN : Menu_Request_Code renames M_Back_Pattern;
+ REQ_NEXT_MATCH : Menu_Request_Code renames M_Next_Match;
+ REQ_PREV_MATCH : Menu_Request_Code renames M_Previous_Match;
+
+ procedure Request_Name (Key : in Menu_Request_Code;
+ Name : out String);
+
+ function Request_Name (Key : Menu_Request_Code) return String;
+ -- Same as function
+
+ ------------------
+ -- Exceptions --
+ ------------------
+
+ Menu_Exception : exception;
+ --
+ -- Menu options
+ --
+ pragma Warnings (Off);
+include(`Menu_Opt_Rep')dnl
+
+ pragma Warnings (On);
+
+ function Default_Menu_Options return Menu_Option_Set;
+ -- Initial default options for a menu.
+ pragma Inline (Default_Menu_Options);
+ --
+ -- Item options
+ --
+ pragma Warnings (Off);
+include(`Item_Rep')dnl
+
+ pragma Warnings (On);
+
+ function Default_Item_Options return Item_Option_Set;
+ -- Initial default options for an item.
+ pragma Inline (Default_Item_Options);
+
+ --
+ -- Item Array
+ --
+ type Item_Array is array (Positive range <>) of aliased Item;
+ pragma Convention (C, Item_Array);
+
+ type Item_Array_Access is access Item_Array;
+
+ procedure Free (IA : in out Item_Array_Access;
+ Free_Items : Boolean := False);
+ -- Release the memory for an allocated item array
+ -- If Free_Items is True, call Delete() for all the items in
+ -- the array.
+
+ -- MANPAGE(`mitem_new.3x')
+
+ -- ANCHOR(`new_item()',`Create')
+ function Create (Name : String;
+ Description : String := "") return Item;
+ -- AKA
+ -- Not inlined.
+
+ -- ANCHOR(`new_item()',`New_Item')
+ function New_Item (Name : String;
+ Description : String := "") return Item
+ renames Create;
+ -- AKA
+
+ -- ANCHOR(`free_item()',`Delete')
+ procedure Delete (Itm : in out Item);
+ -- AKA
+ -- Resets Itm to Null_Item
+
+ -- MANPAGE(`mitem_value.3x')
+
+ -- ANCHOR(`set_item_value()',`Set_Value')
+ procedure Set_Value (Itm : in Item;
+ Value : in Boolean := True);
+ -- AKA
+ pragma Inline (Set_Value);
+
+ -- ANCHOR(`item_value()',`Value')
+ function Value (Itm : Item) return Boolean;
+ -- AKA
+ pragma Inline (Value);
+
+ -- MANPAGE(`mitem_visible.3x')
+
+ -- ANCHOR(`item_visible()',`Visible')
+ function Visible (Itm : Item) return Boolean;
+ -- AKA
+ pragma Inline (Visible);
+
+ -- MANPAGE(`mitem_opts.3x')
+
+ -- ANCHOR(`set_item_opts()',`Set_Options')
+ procedure Set_Options (Itm : in Item;
+ Options : in Item_Option_Set);
+ -- AKA
+ -- An overloaded Set_Options is defined later. Pragma Inline appears there
+
+ -- ANCHOR(`item_opts_on()',`Switch_Options')
+ procedure Switch_Options (Itm : in Item;
+ Options : in Item_Option_Set;
+ On : Boolean := True);
+ -- AKA
+ -- ALIAS(`item_opts_off()')
+ -- An overloaded Switch_Options is defined later.
+ -- Pragma Inline appears there
+
+ -- ANCHOR(`item_opts()',`Get_Options')
+ procedure Get_Options (Itm : in Item;
+ Options : out Item_Option_Set);
+ -- AKA
+
+ -- ANCHOR(`item_opts()',`Get_Options')
+ function Get_Options (Itm : Item := Null_Item) return Item_Option_Set;
+ -- AKA
+ -- An overloaded Get_Options is defined later. Pragma Inline appears there
+
+ -- MANPAGE(`mitem_name.3x')
+
+ -- ANCHOR(`item_name()',`Name')
+ procedure Name (Itm : in Item;
+ Name : out String);
+ -- AKA
+ function Name (Itm : Item) return String;
+ -- AKA
+ -- Implemented as function
+ pragma Inline (Name);
+
+ -- ANCHOR(`item_description();',`Description')
+ procedure Description (Itm : in Item;
+ Description : out String);
+ -- AKA
+
+ function Description (Itm : Item) return String;
+ -- AKA
+ -- Implemented as function
+ pragma Inline (Description);
+
+ -- MANPAGE(`mitem_current.3x')
+
+ -- ANCHOR(`set_current_item()',`Set_Current')
+ procedure Set_Current (Men : in Menu;
+ Itm : in Item);
+ -- AKA
+ pragma Inline (Set_Current);
+
+ -- ANCHOR(`current_item()',`Current')
+ function Current (Men : Menu) return Item;
+ -- AKA
+ pragma Inline (Current);
+
+ -- ANCHOR(`set_top_row()',`Set_Top_Row')
+ procedure Set_Top_Row (Men : in Menu;
+ Line : in Line_Position);
+ -- AKA
+ pragma Inline (Set_Top_Row);
+
+ -- ANCHOR(`top_row()',`Top_Row')
+ function Top_Row (Men : Menu) return Line_Position;
+ -- AKA
+ pragma Inline (Top_Row);
+
+ -- ANCHOR(`item_index()',`Get_Index')
+ function Get_Index (Itm : Item) return Positive;
+ -- AKA
+ -- Please note that in this binding we start the numbering of items
+ -- with 1. So this is number is one more than you get from the low
+ -- level call.
+ pragma Inline (Get_Index);
+
+ -- MANPAGE(`menu_post.3x')
+
+ -- ANCHOR(`post_menu()',`Post')
+ procedure Post (Men : in Menu;
+ Post : in Boolean := True);
+ -- AKA
+ -- ALIAS(`unpost_menu()')
+ pragma Inline (Post);
+
+ -- MANPAGE(`menu_opts.3x')
+
+ -- ANCHOR(`set_menu_opts()',`Set_Options')
+ procedure Set_Options (Men : in Menu;
+ Options : in Menu_Option_Set);
+ -- AKA
+ pragma Inline (Set_Options);
+
+ -- ANCHOR(`menu_opts_on()',`Switch_Options')
+ procedure Switch_Options (Men : in Menu;
+ Options : in Menu_Option_Set;
+ On : Boolean := True);
+ -- AKA
+ -- ALIAS(`menu_opts_off()')
+ pragma Inline (Switch_Options);
+
+ -- ANCHOR(`menu_opts()',`Get_Options')
+ procedure Get_Options (Men : in Menu;
+ Options : out Menu_Option_Set);
+ -- AKA
+
+ -- ANCHOR(`menu_opts()',`Get_Options')
+ function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set;
+ -- AKA
+ pragma Inline (Get_Options);
+
+ -- MANPAGE(`menu_win.3x')
+
+ -- ANCHOR(`set_menu_win()',`Set_Window')
+ procedure Set_Window (Men : in Menu;
+ Win : in Window);
+ -- AKA
+ pragma Inline (Set_Window);
+
+ -- ANCHOR(`menu_win()',`Get_Window')
+ function Get_Window (Men : Menu) return Window;
+ -- AKA
+ pragma Inline (Get_Window);
+
+ -- ANCHOR(`set_menu_sub()',`Set_Sub_Window')
+ procedure Set_Sub_Window (Men : in Menu;
+ Win : in Window);
+ -- AKA
+ pragma Inline (Set_Sub_Window);
+
+ -- ANCHOR(`menu_sub()',`Get_Sub_Window')
+ function Get_Sub_Window (Men : Menu) return Window;
+ -- AKA
+ pragma Inline (Get_Sub_Window);
+
+ -- ANCHOR(`scale_menu()',`Scale')
+ procedure Scale (Men : in Menu;
+ Lines : out Line_Count;
+ Columns : out Column_Count);
+ -- AKA
+ pragma Inline (Scale);
+
+ -- MANPAGE(`menu_cursor.3x')
+
+ -- ANCHOR(`pos_menu_cursor()',`Position_Cursor')
+ procedure Position_Cursor (Men : Menu);
+ -- AKA
+ pragma Inline (Position_Cursor);
+
+ -- MANPAGE(`menu_mark.3x')
+
+ -- ANCHOR(`set_menu_mark()',`Set_Mark')
+ procedure Set_Mark (Men : in Menu;
+ Mark : in String);
+ -- AKA
+ pragma Inline (Set_Mark);
+
+ -- ANCHOR(`menu_mark()',`Mark')
+ procedure Mark (Men : in Menu;
+ Mark : out String);
+ -- AKA
+
+ function Mark (Men : Menu) return String;
+ -- AKA
+ -- Implemented as function
+ pragma Inline (Mark);
+
+ -- MANPAGE(`menu_attributes.3x')
+
+ -- ANCHOR(`set_menu_fore()',`Set_Foreground')
+ procedure Set_Foreground
+ (Men : in Menu;
+ Fore : in Character_Attribute_Set := Normal_Video;
+ Color : in Color_Pair := Color_Pair'First);
+ -- AKA
+ pragma Inline (Set_Foreground);
+
+ -- ANCHOR(`menu_fore()',`Foreground')
+ procedure Foreground (Men : in Menu;
+ Fore : out Character_Attribute_Set);
+ -- AKA
+
+ -- ANCHOR(`menu_fore()',`Foreground')
+ procedure Foreground (Men : in Menu;
+ Fore : out Character_Attribute_Set;
+ Color : out Color_Pair);
+ -- AKA
+ pragma Inline (Foreground);
+
+ -- ANCHOR(`set_menu_back()',`Set_Background')
+ procedure Set_Background
+ (Men : in Menu;
+ Back : in Character_Attribute_Set := Normal_Video;
+ Color : in Color_Pair := Color_Pair'First);
+ -- AKA
+ pragma Inline (Set_Background);
+
+ -- ANCHOR(`menu_back()',`Background')
+ procedure Background (Men : in Menu;
+ Back : out Character_Attribute_Set);
+ -- AKA
+ -- ANCHOR(`menu_back()',`Background')
+
+ procedure Background (Men : in Menu;
+ Back : out Character_Attribute_Set;
+ Color : out Color_Pair);
+ -- AKA
+ pragma Inline (Background);
+
+ -- ANCHOR(`set_menu_grey()',`Set_Grey')
+ procedure Set_Grey
+ (Men : in Menu;
+ Grey : in Character_Attribute_Set := Normal_Video;
+ Color : in Color_Pair := Color_Pair'First);
+ -- AKA
+ pragma Inline (Set_Grey);
+
+ -- ANCHOR(`menu_grey()',`Grey')
+ procedure Grey (Men : in Menu;
+ Grey : out Character_Attribute_Set);
+ -- AKA
+
+ -- ANCHOR(`menu_grey()',`Grey')
+ procedure Grey
+ (Men : in Menu;
+ Grey : out Character_Attribute_Set;
+ Color : out Color_Pair);
+ -- AKA
+ pragma Inline (Grey);
+
+ -- ANCHOR(`set_menu_pad()',`Set_Pad_Character')
+ procedure Set_Pad_Character (Men : in Menu;
+ Pad : in Character := Space);
+ -- AKA
+ pragma Inline (Set_Pad_Character);
+
+ -- ANCHOR(`menu_pad()',`Pad_Character')
+ procedure Pad_Character (Men : in Menu;
+ Pad : out Character);
+ -- AKA
+ pragma Inline (Pad_Character);
+
+ -- MANPAGE(`menu_spacing.3x')
+
+ -- ANCHOR(`set_menu_spacing()',`Set_Spacing')
+ procedure Set_Spacing (Men : in Menu;
+ Descr : in Column_Position := 0;
+ Row : in Line_Position := 0;
+ Col : in Column_Position := 0);
+ -- AKA
+ pragma Inline (Set_Spacing);
+
+ -- ANCHOR(`menu_spacing()',`Spacing')
+ procedure Spacing (Men : in Menu;
+ Descr : out Column_Position;
+ Row : out Line_Position;
+ Col : out Column_Position);
+ -- AKA
+ pragma Inline (Spacing);
+
+ -- MANPAGE(`menu_pattern.3x')
+
+ -- ANCHOR(`set_menu_pattern()',`Set_Pattern')
+ function Set_Pattern (Men : Menu;
+ Text : String) return Boolean;
+ -- AKA
+ -- Return TRUE if the pattern matches, FALSE otherwise
+ pragma Inline (Set_Pattern);
+
+ -- ANCHOR(`menu_pattern()',`Pattern')
+ procedure Pattern (Men : in Menu;
+ Text : out String);
+ -- AKA
+ pragma Inline (Pattern);
+
+ -- MANPAGE(`menu_format.3x')
+
+ -- ANCHOR(`set_menu_format()',`Set_Format')
+ procedure Set_Format (Men : in Menu;
+ Lines : in Line_Count;
+ Columns : in Column_Count);
+ -- Not implemented: 0 argument for Lines or Columns;
+ -- instead use Format to get the current sizes
+ -- The default format is 16 rows, 1 column. Calling
+ -- set_menu_format with a null menu pointer will change this
+ -- default. A zero row or column argument to set_menu_format
+ -- is interpreted as a request not to change the current
+ -- value.
+ -- AKA
+ pragma Inline (Set_Format);
+
+ -- ANCHOR(`menu_format()',`Format')
+ procedure Format (Men : in Menu;
+ Lines : out Line_Count;
+ Columns : out Column_Count);
+ -- AKA
+ pragma Inline (Format);
+
+ -- MANPAGE(`menu_hook.3x')
+
+ type Menu_Hook_Function is access procedure (Men : in Menu);
+ pragma Convention (C, Menu_Hook_Function);
+
+ -- ANCHOR(`set_item_init()',`Set_Item_Init_Hook')
+ procedure Set_Item_Init_Hook (Men : in Menu;
+ Proc : in Menu_Hook_Function);
+ -- AKA
+ pragma Inline (Set_Item_Init_Hook);
+
+ -- ANCHOR(`set_item_term()',`Set_Item_Term_Hook')
+ procedure Set_Item_Term_Hook (Men : in Menu;
+ Proc : in Menu_Hook_Function);
+ -- AKA
+ pragma Inline (Set_Item_Term_Hook);
+
+ -- ANCHOR(`set_menu_init()',`Set_Menu_Init_Hook')
+ procedure Set_Menu_Init_Hook (Men : in Menu;
+ Proc : in Menu_Hook_Function);
+ -- AKA
+ pragma Inline (Set_Menu_Init_Hook);
+
+ -- ANCHOR(`set_menu_term()',`Set_Menu_Term_Hook')
+ procedure Set_Menu_Term_Hook (Men : in Menu;
+ Proc : in Menu_Hook_Function);
+ -- AKA
+ pragma Inline (Set_Menu_Term_Hook);
+
+ -- ANCHOR(`item_init()',`Get_Item_Init_Hook')
+ function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function;
+ -- AKA
+ pragma Inline (Get_Item_Init_Hook);
+
+ -- ANCHOR(`item_term()',`Get_Item_Term_Hook')
+ function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function;
+ -- AKA
+ pragma Inline (Get_Item_Term_Hook);
+
+ -- ANCHOR(`menu_init()',`Get_Menu_Init_Hook')
+ function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function;
+ -- AKA
+ pragma Inline (Get_Menu_Init_Hook);
+
+ -- ANCHOR(`menu_term()',`Get_Menu_Term_Hook')
+ function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function;
+ -- AKA
+ pragma Inline (Get_Menu_Term_Hook);
+
+ -- MANPAGE(`menu_items.3x')
+
+ -- ANCHOR(`set_menu_items()',`Redefine')
+ procedure Redefine (Men : in Menu;
+ Items : in Item_Array_Access);
+ -- AKA
+ pragma Inline (Redefine);
+
+ procedure Set_Items (Men : in Menu;
+ Items : in Item_Array_Access) renames Redefine;
+ -- pragma Inline (Set_Items);
+
+ -- ANCHOR(`menu_items()',`Items')
+ function Items (Men : Menu;
+ Index : Positive) return Item;
+ -- AKA
+ pragma Inline (Items);
+
+ -- ANCHOR(`item_count()',`Item_Count')
+ function Item_Count (Men : Menu) return Natural;
+ -- AKA
+ pragma Inline (Item_Count);
+
+ -- MANPAGE(`menu_new.3x')
+
+ -- ANCHOR(`new_menu()',`Create')
+ function Create (Items : Item_Array_Access) return Menu;
+ -- AKA
+ -- Not inlined
+
+ function New_Menu (Items : Item_Array_Access) return Menu renames Create;
+
+ -- ANCHOR(`free_menu()',`Delete')
+ procedure Delete (Men : in out Menu);
+ -- AKA
+ -- Reset Men to Null_Menu
+ -- Not inlined
+
+ -- MANPAGE(`menu_driver.3x')
+
+ type Driver_Result is (Menu_Ok,
+ Request_Denied,
+ Unknown_Request,
+ No_Match);
+
+ -- ANCHOR(`menu_driver()',`Driver')
+ function Driver (Men : Menu;
+ Key : Key_Code) return Driver_Result;
+ -- AKA
+ -- Driver is not inlined
+
+ -- ANCHOR(`menu_requestname.3x')
+ -- Not Implemented: menu_request_name, menu_request_by_name
+-------------------------------------------------------------------------------
+private
+ type Item is new System.Storage_Elements.Integer_Address;
+ type Menu is new System.Storage_Elements.Integer_Address;
+
+ Null_Item : constant Item := 0;
+ Null_Menu : constant Menu := 0;
+
+end Terminal_Interface.Curses.Menus;
diff --git a/Ada95/gen/terminal_interface-curses-mouse.ads.m4 b/Ada95/gen/terminal_interface-curses-mouse.ads.m4
new file mode 100644
index 0000000..b59ebbf
--- /dev/null
+++ b/Ada95/gen/terminal_interface-curses-mouse.ads.m4
@@ -0,0 +1,182 @@
+-- -*- ada -*-
+define(`HTMLNAME',`terminal_interface-curses-mouse__ads.htm')dnl
+include(M4MACRO)dnl
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Mouse --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2004,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.27 $
+-- $Date: 2006/06/25 14:30:22 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+include(`Mouse_Base_Defs')
+with System;
+
+package Terminal_Interface.Curses.Mouse is
+ pragma Preelaborate (Terminal_Interface.Curses.Mouse);
+
+ -- MANPAGE(`curs_mouse.3x')
+ -- Please note, that in ncurses-1.9.9e documentation mouse support
+ -- is still marked as experimental. So also this binding will change
+ -- if the ncurses methods change.
+ --
+ -- mouse_trafo, wmouse_trafo are implemented as Transform_Coordinates
+ -- in the parent package.
+ --
+ -- Not implemented:
+ -- REPORT_MOUSE_POSITION (i.e. as a parameter to Register_Reportable_Event
+ -- or Start_Mouse)
+ type Event_Mask is private;
+ No_Events : constant Event_Mask;
+ All_Events : constant Event_Mask;
+
+ type Mouse_Button is (Left, -- aka: Button 1
+ Middle, -- aka: Button 2
+ Right, -- aka: Button 3
+ Button4, -- aka: Button 4
+ Control, -- Control Key
+ Shift, -- Shift Key
+ Alt); -- ALT Key
+
+ subtype Real_Buttons is Mouse_Button range Left .. Button4;
+ subtype Modifier_Keys is Mouse_Button range Control .. Alt;
+
+ type Button_State is (Released,
+ Pressed,
+ Clicked,
+ Double_Clicked,
+ Triple_Clicked);
+
+ type Button_States is array (Button_State) of Boolean;
+ pragma Pack (Button_States);
+
+ All_Clicks : constant Button_States := (Clicked .. Triple_Clicked => True,
+ others => False);
+ All_States : constant Button_States := (others => True);
+
+ type Mouse_Event is private;
+
+ -- MANPAGE(`curs_mouse.3x')
+
+ function Has_Mouse return Boolean;
+ -- Return true if a mouse device is supported, false otherwise.
+
+ procedure Register_Reportable_Event
+ (Button : in Mouse_Button;
+ State : in Button_State;
+ Mask : in out Event_Mask);
+ -- Stores the event described by the button and the state in the mask.
+ -- Before you call this the first time, you should init the mask
+ -- with the Empty_Mask constant
+ pragma Inline (Register_Reportable_Event);
+
+ procedure Register_Reportable_Events
+ (Button : in Mouse_Button;
+ State : in Button_States;
+ Mask : in out Event_Mask);
+ -- Register all events described by the Button and the State bitmap.
+ -- Before you call this the first time, you should init the mask
+ -- with the Empty_Mask constant
+
+ -- ANCHOR(`mousemask()',`Start_Mouse')
+ -- There is one difference to mousmask(): we return the value of the
+ -- old mask, that means the event mask value before this call.
+ -- Not Implemented: The library version
+ -- returns a Mouse_Mask that tells which events are reported.
+ function Start_Mouse (Mask : Event_Mask := All_Events)
+ return Event_Mask;
+ -- AKA
+ pragma Inline (Start_Mouse);
+
+ procedure End_Mouse (Mask : in Event_Mask := No_Events);
+ -- Terminates the mouse, restores the specified event mask
+ pragma Inline (End_Mouse);
+
+ -- ANCHOR(`getmouse()',`Get_Mouse')
+ function Get_Mouse return Mouse_Event;
+ -- AKA
+ pragma Inline (Get_Mouse);
+
+ procedure Get_Event (Event : in Mouse_Event;
+ Y : out Line_Position;
+ X : out Column_Position;
+ Button : out Mouse_Button;
+ State : out Button_State);
+ -- !!! Warning: X and Y are screen coordinates. Due to ripped of lines they
+ -- may not be identical to window coordinates.
+ -- Not Implemented: Get_Event only reports one event, the C library
+ -- version supports multiple events, e.g. {click-1, click-3}
+ pragma Inline (Get_Event);
+
+ -- ANCHOR(`ungetmouse()',`Unget_Mouse')
+ procedure Unget_Mouse (Event : in Mouse_Event);
+ -- AKA
+ pragma Inline (Unget_Mouse);
+
+ -- ANCHOR(`wenclose()',`Enclosed_In_Window')
+ function Enclosed_In_Window (Win : Window := Standard_Window;
+ Event : Mouse_Event) return Boolean;
+ -- AKA
+ -- But : use event instead of screen coordinates.
+ pragma Inline (Enclosed_In_Window);
+
+ -- ANCHOR(`mouseinterval()',`Mouse_Interval')
+ function Mouse_Interval (Msec : Natural := 200) return Natural;
+ -- AKA
+ pragma Inline (Mouse_Interval);
+
+private
+ type Event_Mask is new Interfaces.C.unsigned_long;
+
+ type Mouse_Event is
+ record
+ Id : Integer range Integer (Interfaces.C.short'First) ..
+ Integer (Interfaces.C.short'Last);
+ X, Y, Z : Integer range Integer (Interfaces.C.int'First) ..
+ Integer (Interfaces.C.int'Last);
+ Bstate : Event_Mask;
+ end record;
+ pragma Convention (C, Mouse_Event);
+
+include(`Mouse_Event_Rep')
+ Generation_Bit_Order : constant System.Bit_Order := System.M4_BIT_ORDER;
+ -- This constant may be different on your system.
+
+include(`Mouse_Events')
+ No_Events : constant Event_Mask := 0;
+ All_Events : constant Event_Mask := ALL_MOUSE_EVENTS;
+
+end Terminal_Interface.Curses.Mouse;
diff --git a/Ada95/gen/terminal_interface-curses-panels-user_data.ads.m4 b/Ada95/gen/terminal_interface-curses-panels-user_data.ads.m4
new file mode 100644
index 0000000..e6def9b
--- /dev/null
+++ b/Ada95/gen/terminal_interface-curses-panels-user_data.ads.m4
@@ -0,0 +1,70 @@
+-- -*- ada -*-
+define(`HTMLNAME',`terminal_interface-curses-panels-user_data__ads.htm')dnl
+include(M4MACRO)dnl
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Panels.User_Data --
+-- --
+-- 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.14 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+
+generic
+ type User is limited private;
+ type User_Access is access all User;
+package Terminal_Interface.Curses.Panels.User_Data is
+ pragma Preelaborate (Terminal_Interface.Curses.Panels.User_Data);
+
+ -- MANPAGE(`panel.3x')
+
+ -- ANCHOR(`set_panel_userptr',`Set_User_Data')
+ procedure Set_User_Data (Pan : in Panel;
+ Data : in User_Access);
+ -- AKA
+ pragma Inline (Set_User_Data);
+
+ -- ANCHOR(`panel_userptr',`Get_User_Data')
+ procedure Get_User_Data (Pan : in Panel;
+ Data : out User_Access);
+ -- AKA
+
+ -- ANCHOR(`panel_userptr',`Get_User_Data')
+ function Get_User_Data (Pan : in Panel) return User_Access;
+ -- AKA
+ -- Same as function
+ pragma Inline (Get_User_Data);
+
+end Terminal_Interface.Curses.Panels.User_Data;
diff --git a/Ada95/gen/terminal_interface-curses-panels.ads.m4 b/Ada95/gen/terminal_interface-curses-panels.ads.m4
new file mode 100644
index 0000000..39b7260
--- /dev/null
+++ b/Ada95/gen/terminal_interface-curses-panels.ads.m4
@@ -0,0 +1,147 @@
+-- -*- ada -*-
+define(`HTMLNAME',`terminal_interface-curses-panels__ads.htm')dnl
+include(M4MACRO)dnl
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Panels --
+-- --
+-- 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.19 $
+-- $Date: 2006/06/25 14:30:22 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with System;
+
+package Terminal_Interface.Curses.Panels is
+ pragma Preelaborate (Terminal_Interface.Curses.Panels);
+include(`Panel_Linker_Options')dnl
+include(`Linker_Options')
+ type Panel is private;
+
+ ---------------------------
+ -- Interface constants --
+ ---------------------------
+ Null_Panel : constant Panel;
+
+ -------------------
+ -- Exceptions --
+ -------------------
+
+ Panel_Exception : exception;
+
+ -- MANPAGE(`panel.3x')
+
+ -- ANCHOR(`new_panel()',`Create')
+ function Create (Win : Window) return Panel;
+ -- AKA
+ pragma Inline (Create);
+
+ -- ANCHOR(`new_panel()',`New_Panel')
+ function New_Panel (Win : Window) return Panel renames Create;
+ -- AKA
+ -- pragma Inline (New_Panel);
+
+ -- ANCHOR(`bottom_panel()',`Bottom')
+ procedure Bottom (Pan : in Panel);
+ -- AKA
+ pragma Inline (Bottom);
+
+ -- ANCHOR(`top_panel()',`Top')
+ procedure Top (Pan : in Panel);
+ -- AKA
+ pragma Inline (Top);
+
+ -- ANCHOR(`show_panel()',`Show')
+ procedure Show (Pan : in Panel);
+ -- AKA
+ pragma Inline (Show);
+
+ -- ANCHOR(`update_panels()',`Update_Panels')
+ procedure Update_Panels;
+ -- AKA
+ pragma Import (C, Update_Panels, "update_panels");
+
+ -- ANCHOR(`hide_panel()',`Hide')
+ procedure Hide (Pan : in Panel);
+ -- AKA
+ pragma Inline (Hide);
+
+ -- ANCHOR(`panel_window()',`Get_Window')
+ function Get_Window (Pan : Panel) return Window;
+ -- AKA
+ pragma Inline (Get_Window);
+
+ -- ANCHOR(`panel_window()',`Panel_Window')
+ function Panel_Window (Pan : Panel) return Window renames Get_Window;
+ -- pragma Inline (Panel_Window);
+
+ -- ANCHOR(`replace_panel()',`Replace')
+ procedure Replace (Pan : in Panel;
+ Win : in Window);
+ -- AKA
+ pragma Inline (Replace);
+
+ -- ANCHOR(`move_panel()',`Move')
+ procedure Move (Pan : in Panel;
+ Line : in Line_Position;
+ Column : in Column_Position);
+ -- AKA
+ pragma Inline (Move);
+
+ -- ANCHOR(`panel_hidden()',`Is_Hidden')
+ function Is_Hidden (Pan : Panel) return Boolean;
+ -- AKA
+ pragma Inline (Is_Hidden);
+
+ -- ANCHOR(`panel_above()',`Above')
+ function Above (Pan : Panel) return Panel;
+ -- AKA
+ pragma Import (C, Above, "panel_above");
+
+ -- ANCHOR(`panel_below()',`Below')
+ function Below (Pan : Panel) return Panel;
+ -- AKA
+ pragma Import (C, Below, "panel_below");
+
+ -- ANCHOR(`del_panel()',`Delete')
+ procedure Delete (Pan : in out Panel);
+ -- AKA
+ pragma Inline (Delete);
+
+private
+ type Panel is new System.Storage_Elements.Integer_Address;
+ Null_Panel : constant Panel := 0;
+
+end Terminal_Interface.Curses.Panels;
diff --git a/Ada95/gen/terminal_interface-curses-trace.ads.m4 b/Ada95/gen/terminal_interface-curses-trace.ads.m4
new file mode 100644
index 0000000..546004f
--- /dev/null
+++ b/Ada95/gen/terminal_interface-curses-trace.ads.m4
@@ -0,0 +1,78 @@
+-- -*- ada -*-
+define(`HTMLNAME',`terminal_interface-curses-trace__ads.htm')dnl
+include(M4MACRO)------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Trace --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control:
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+
+package Terminal_Interface.Curses.Trace is
+ pragma Preelaborate (Terminal_Interface.Curses.Trace);
+
+ pragma Warnings (Off);
+include(`Trace_Defs')
+
+ pragma Warnings (On);
+
+ Trace_Disable : constant Trace_Attribute_Set := (others => False);
+
+ Trace_Ordinary : constant Trace_Attribute_Set :=
+ (Times => True,
+ Tputs => True,
+ Update => True,
+ Cursor_Move => True,
+ Character_Output => True,
+ others => False);
+ Trace_Maximum : constant Trace_Attribute_Set := (others => True);
+
+------------------------------------------------------------------------------
+
+ -- MANPAGE(`curs_trace.3x')
+
+ -- ANCHOR(`trace()',`Trace_on')
+ procedure Trace_On (x : Trace_Attribute_Set);
+ -- The debugging library has trace.
+
+ -- ANCHOR(`_tracef()',`Trace_Put')
+ procedure Trace_Put (str : String);
+ -- AKA
+
+ Current_Trace_Setting : Trace_Attribute_Set;
+ pragma Import (C, Current_Trace_Setting, "_nc_tracing");
+
+end Terminal_Interface.Curses.Trace;
diff --git a/Ada95/gen/terminal_interface-curses.adb.m4 b/Ada95/gen/terminal_interface-curses.adb.m4
new file mode 100644
index 0000000..75ddb96
--- /dev/null
+++ b/Ada95/gen/terminal_interface-curses.adb.m4
@@ -0,0 +1,2502 @@
+-- -*- ada -*-
+define(`HTMLNAME',`terminal_interface-curses__adb.htm')dnl
+include(M4MACRO)------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2007,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.5 $
+-- $Date: 2008/07/26 18:46:32 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with System;
+
+with Terminal_Interface.Curses.Aux;
+with Interfaces.C; use Interfaces.C;
+with Interfaces.C.Strings; use Interfaces.C.Strings;
+with Ada.Characters.Handling; use Ada.Characters.Handling;
+with Ada.Strings.Fixed;
+
+package body Terminal_Interface.Curses is
+
+ use Aux;
+ use type System.Bit_Order;
+
+ package ASF renames Ada.Strings.Fixed;
+
+ type chtype_array is array (size_t range <>)
+ of aliased Attributed_Character;
+ pragma Convention (C, chtype_array);
+
+------------------------------------------------------------------------------
+ function Key_Name (Key : in Real_Key_Code) return String
+ is
+ function Keyname (K : C_Int) return chars_ptr;
+ pragma Import (C, Keyname, "keyname");
+
+ Ch : Character;
+ begin
+ if Key <= Character'Pos (Character'Last) then
+ Ch := Character'Val (Key);
+ if Is_Control (Ch) then
+ return Un_Control (Attributed_Character'(Ch => Ch,
+ Color => Color_Pair'First,
+ Attr => Normal_Video));
+ elsif Is_Graphic (Ch) then
+ declare
+ S : String (1 .. 1);
+ begin
+ S (1) := Ch;
+ return S;
+ end;
+ else
+ return "";
+ end if;
+ else
+ return Fill_String (Keyname (C_Int (Key)));
+ end if;
+ end Key_Name;
+
+ procedure Key_Name (Key : in Real_Key_Code;
+ Name : out String)
+ is
+ begin
+ ASF.Move (Key_Name (Key), Name);
+ end Key_Name;
+
+------------------------------------------------------------------------------
+ procedure Init_Screen
+ is
+ function Initscr return Window;
+ pragma Import (C, Initscr, "initscr");
+
+ W : Window;
+ begin
+ W := Initscr;
+ if W = Null_Window then
+ raise Curses_Exception;
+ end if;
+ end Init_Screen;
+
+ procedure End_Windows
+ is
+ function Endwin return C_Int;
+ pragma Import (C, Endwin, "endwin");
+ begin
+ if Endwin = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end End_Windows;
+
+ function Is_End_Window return Boolean
+ is
+ function Isendwin return Curses_Bool;
+ pragma Import (C, Isendwin, "isendwin");
+ begin
+ if Isendwin = Curses_Bool_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Is_End_Window;
+------------------------------------------------------------------------------
+ procedure Move_Cursor (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position)
+ is
+ function Wmove (Win : Window;
+ Line : C_Int;
+ Column : C_Int
+ ) return C_Int;
+ pragma Import (C, Wmove, "wmove");
+ begin
+ if Wmove (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Move_Cursor;
+------------------------------------------------------------------------------
+ procedure Add (Win : in Window := Standard_Window;
+ Ch : in Attributed_Character)
+ is
+ function Waddch (W : Window;
+ Ch : C_Chtype) return C_Int;
+ pragma Import (C, Waddch, "waddch");
+ begin
+ if Waddch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Add;
+
+ procedure Add (Win : in Window := Standard_Window;
+ Ch : in Character)
+ is
+ begin
+ Add (Win,
+ Attributed_Character'(Ch => Ch,
+ Color => Color_Pair'First,
+ Attr => Normal_Video));
+ end Add;
+
+ procedure Add
+ (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position;
+ Ch : in Attributed_Character)
+ is
+ function mvwaddch (W : Window;
+ Y : C_Int;
+ X : C_Int;
+ Ch : C_Chtype) return C_Int;
+ pragma Import (C, mvwaddch, "mvwaddch");
+ begin
+ if mvwaddch (Win, C_Int (Line),
+ C_Int (Column),
+ AttrChar_To_Chtype (Ch)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Add;
+
+ procedure Add
+ (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position;
+ Ch : in Character)
+ is
+ begin
+ Add (Win,
+ Line,
+ Column,
+ Attributed_Character'(Ch => Ch,
+ Color => Color_Pair'First,
+ Attr => Normal_Video));
+ end Add;
+
+ procedure Add_With_Immediate_Echo
+ (Win : in Window := Standard_Window;
+ Ch : in Attributed_Character)
+ is
+ function Wechochar (W : Window;
+ Ch : C_Chtype) return C_Int;
+ pragma Import (C, Wechochar, "wechochar");
+ begin
+ if Wechochar (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Add_With_Immediate_Echo;
+
+ procedure Add_With_Immediate_Echo
+ (Win : in Window := Standard_Window;
+ Ch : in Character)
+ is
+ begin
+ Add_With_Immediate_Echo
+ (Win,
+ Attributed_Character'(Ch => Ch,
+ Color => Color_Pair'First,
+ Attr => Normal_Video));
+ end Add_With_Immediate_Echo;
+------------------------------------------------------------------------------
+ function Create (Number_Of_Lines : Line_Count;
+ Number_Of_Columns : Column_Count;
+ First_Line_Position : Line_Position;
+ First_Column_Position : Column_Position) return Window
+ is
+ function Newwin (Number_Of_Lines : C_Int;
+ Number_Of_Columns : C_Int;
+ First_Line_Position : C_Int;
+ First_Column_Position : C_Int) return Window;
+ pragma Import (C, Newwin, "newwin");
+
+ W : Window;
+ begin
+ W := Newwin (C_Int (Number_Of_Lines),
+ C_Int (Number_Of_Columns),
+ C_Int (First_Line_Position),
+ C_Int (First_Column_Position));
+ if W = Null_Window then
+ raise Curses_Exception;
+ end if;
+ return W;
+ end Create;
+
+ procedure Delete (Win : in out Window)
+ is
+ function Wdelwin (W : Window) return C_Int;
+ pragma Import (C, Wdelwin, "delwin");
+ begin
+ if Wdelwin (Win) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ Win := Null_Window;
+ end Delete;
+
+ function Sub_Window
+ (Win : Window := Standard_Window;
+ Number_Of_Lines : Line_Count;
+ Number_Of_Columns : Column_Count;
+ First_Line_Position : Line_Position;
+ First_Column_Position : Column_Position) return Window
+ is
+ function Subwin
+ (Win : Window;
+ Number_Of_Lines : C_Int;
+ Number_Of_Columns : C_Int;
+ First_Line_Position : C_Int;
+ First_Column_Position : C_Int) return Window;
+ pragma Import (C, Subwin, "subwin");
+
+ W : Window;
+ begin
+ W := Subwin (Win,
+ C_Int (Number_Of_Lines),
+ C_Int (Number_Of_Columns),
+ C_Int (First_Line_Position),
+ C_Int (First_Column_Position));
+ if W = Null_Window then
+ raise Curses_Exception;
+ end if;
+ return W;
+ end Sub_Window;
+
+ function Derived_Window
+ (Win : Window := Standard_Window;
+ Number_Of_Lines : Line_Count;
+ Number_Of_Columns : Column_Count;
+ First_Line_Position : Line_Position;
+ First_Column_Position : Column_Position) return Window
+ is
+ function Derwin
+ (Win : Window;
+ Number_Of_Lines : C_Int;
+ Number_Of_Columns : C_Int;
+ First_Line_Position : C_Int;
+ First_Column_Position : C_Int) return Window;
+ pragma Import (C, Derwin, "derwin");
+
+ W : Window;
+ begin
+ W := Derwin (Win,
+ C_Int (Number_Of_Lines),
+ C_Int (Number_Of_Columns),
+ C_Int (First_Line_Position),
+ C_Int (First_Column_Position));
+ if W = Null_Window then
+ raise Curses_Exception;
+ end if;
+ return W;
+ end Derived_Window;
+
+ function Duplicate (Win : Window) return Window
+ is
+ function Dupwin (Win : Window) return Window;
+ pragma Import (C, Dupwin, "dupwin");
+
+ W : constant Window := Dupwin (Win);
+ begin
+ if W = Null_Window then
+ raise Curses_Exception;
+ end if;
+ return W;
+ end Duplicate;
+
+ procedure Move_Window (Win : in Window;
+ Line : in Line_Position;
+ Column : in Column_Position)
+ is
+ function Mvwin (Win : Window;
+ Line : C_Int;
+ Column : C_Int) return C_Int;
+ pragma Import (C, Mvwin, "mvwin");
+ begin
+ if Mvwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Move_Window;
+
+ procedure Move_Derived_Window (Win : in Window;
+ Line : in Line_Position;
+ Column : in Column_Position)
+ is
+ function Mvderwin (Win : Window;
+ Line : C_Int;
+ Column : C_Int) return C_Int;
+ pragma Import (C, Mvderwin, "mvderwin");
+ begin
+ if Mvderwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Move_Derived_Window;
+
+ procedure Set_Synch_Mode (Win : in Window := Standard_Window;
+ Mode : in Boolean := False)
+ is
+ function Syncok (Win : Window;
+ Mode : Curses_Bool) return C_Int;
+ pragma Import (C, Syncok, "syncok");
+ begin
+ if Syncok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Set_Synch_Mode;
+------------------------------------------------------------------------------
+ procedure Add (Win : in Window := Standard_Window;
+ Str : in String;
+ Len : in Integer := -1)
+ is
+ function Waddnstr (Win : Window;
+ Str : char_array;
+ Len : C_Int := -1) return C_Int;
+ pragma Import (C, Waddnstr, "waddnstr");
+
+ Txt : char_array (0 .. Str'Length);
+ Length : size_t;
+ begin
+ To_C (Str, Txt, Length);
+ if Waddnstr (Win, Txt, C_Int (Len)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Add;
+
+ procedure Add
+ (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position;
+ Str : in String;
+ Len : in Integer := -1)
+ is
+ begin
+ Move_Cursor (Win, Line, Column);
+ Add (Win, Str, Len);
+ end Add;
+------------------------------------------------------------------------------
+ procedure Add
+ (Win : in Window := Standard_Window;
+ Str : in Attributed_String;
+ Len : in Integer := -1)
+ is
+ function Waddchnstr (Win : Window;
+ Str : chtype_array;
+ Len : C_Int := -1) return C_Int;
+ pragma Import (C, Waddchnstr, "waddchnstr");
+
+ Txt : chtype_array (0 .. Str'Length);
+ begin
+ for Length in 1 .. size_t (Str'Length) loop
+ Txt (Length - 1) := Str (Natural (Length));
+ end loop;
+ Txt (Str'Length) := Default_Character;
+ if Waddchnstr (Win,
+ Txt,
+ C_Int (Len)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Add;
+
+ procedure Add
+ (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position;
+ Str : in Attributed_String;
+ Len : in Integer := -1)
+ is
+ begin
+ Move_Cursor (Win, Line, Column);
+ Add (Win, Str, Len);
+ end Add;
+------------------------------------------------------------------------------
+ procedure Border
+ (Win : in Window := Standard_Window;
+ Left_Side_Symbol : in Attributed_Character := Default_Character;
+ Right_Side_Symbol : in Attributed_Character := Default_Character;
+ Top_Side_Symbol : in Attributed_Character := Default_Character;
+ Bottom_Side_Symbol : in Attributed_Character := Default_Character;
+ Upper_Left_Corner_Symbol : in Attributed_Character := Default_Character;
+ Upper_Right_Corner_Symbol : in Attributed_Character := Default_Character;
+ Lower_Left_Corner_Symbol : in Attributed_Character := Default_Character;
+ Lower_Right_Corner_Symbol : in Attributed_Character := Default_Character)
+ is
+ function Wborder (W : Window;
+ LS : C_Chtype;
+ RS : C_Chtype;
+ TS : C_Chtype;
+ BS : C_Chtype;
+ ULC : C_Chtype;
+ URC : C_Chtype;
+ LLC : C_Chtype;
+ LRC : C_Chtype) return C_Int;
+ pragma Import (C, Wborder, "wborder");
+ begin
+ if Wborder (Win,
+ AttrChar_To_Chtype (Left_Side_Symbol),
+ AttrChar_To_Chtype (Right_Side_Symbol),
+ AttrChar_To_Chtype (Top_Side_Symbol),
+ AttrChar_To_Chtype (Bottom_Side_Symbol),
+ AttrChar_To_Chtype (Upper_Left_Corner_Symbol),
+ AttrChar_To_Chtype (Upper_Right_Corner_Symbol),
+ AttrChar_To_Chtype (Lower_Left_Corner_Symbol),
+ AttrChar_To_Chtype (Lower_Right_Corner_Symbol)
+ ) = Curses_Err
+ then
+ raise Curses_Exception;
+ end if;
+ end Border;
+
+ procedure Box
+ (Win : in Window := Standard_Window;
+ Vertical_Symbol : in Attributed_Character := Default_Character;
+ Horizontal_Symbol : in Attributed_Character := Default_Character)
+ is
+ begin
+ Border (Win,
+ Vertical_Symbol, Vertical_Symbol,
+ Horizontal_Symbol, Horizontal_Symbol);
+ end Box;
+
+ procedure Horizontal_Line
+ (Win : in Window := Standard_Window;
+ Line_Size : in Natural;
+ Line_Symbol : in Attributed_Character := Default_Character)
+ is
+ function Whline (W : Window;
+ Ch : C_Chtype;
+ Len : C_Int) return C_Int;
+ pragma Import (C, Whline, "whline");
+ begin
+ if Whline (Win,
+ AttrChar_To_Chtype (Line_Symbol),
+ C_Int (Line_Size)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Horizontal_Line;
+
+ procedure Vertical_Line
+ (Win : in Window := Standard_Window;
+ Line_Size : in Natural;
+ Line_Symbol : in Attributed_Character := Default_Character)
+ is
+ function Wvline (W : Window;
+ Ch : C_Chtype;
+ Len : C_Int) return C_Int;
+ pragma Import (C, Wvline, "wvline");
+ begin
+ if Wvline (Win,
+ AttrChar_To_Chtype (Line_Symbol),
+ C_Int (Line_Size)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Vertical_Line;
+
+------------------------------------------------------------------------------
+ function Get_Keystroke (Win : Window := Standard_Window)
+ return Real_Key_Code
+ is
+ function Wgetch (W : Window) return C_Int;
+ pragma Import (C, Wgetch, "wgetch");
+
+ C : constant C_Int := Wgetch (Win);
+ begin
+ if C = Curses_Err then
+ return Key_None;
+ else
+ return Real_Key_Code (C);
+ end if;
+ end Get_Keystroke;
+
+ procedure Undo_Keystroke (Key : in Real_Key_Code)
+ is
+ function Ungetch (Ch : C_Int) return C_Int;
+ pragma Import (C, Ungetch, "ungetch");
+ begin
+ if Ungetch (C_Int (Key)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Undo_Keystroke;
+
+ function Has_Key (Key : Special_Key_Code) return Boolean
+ is
+ function Haskey (Key : C_Int) return C_Int;
+ pragma Import (C, Haskey, "has_key");
+ begin
+ if Haskey (C_Int (Key)) = Curses_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Has_Key;
+
+ function Is_Function_Key (Key : Special_Key_Code) return Boolean
+ is
+ L : constant Special_Key_Code := Special_Key_Code (Natural (Key_F0) +
+ Natural (Function_Key_Number'Last));
+ begin
+ if (Key >= Key_F0) and then (Key <= L) then
+ return True;
+ else
+ return False;
+ end if;
+ end Is_Function_Key;
+
+ function Function_Key (Key : Real_Key_Code)
+ return Function_Key_Number
+ is
+ begin
+ if Is_Function_Key (Key) then
+ return Function_Key_Number (Key - Key_F0);
+ else
+ raise Constraint_Error;
+ end if;
+ end Function_Key;
+
+ function Function_Key_Code (Key : Function_Key_Number) return Real_Key_Code
+ is
+ begin
+ return Real_Key_Code (Natural (Key_F0) + Natural (Key));
+ end Function_Key_Code;
+------------------------------------------------------------------------------
+ procedure Standout (Win : Window := Standard_Window;
+ On : Boolean := True)
+ is
+ function wstandout (Win : Window) return C_Int;
+ pragma Import (C, wstandout, "wstandout");
+ function wstandend (Win : Window) return C_Int;
+ pragma Import (C, wstandend, "wstandend");
+
+ Err : C_Int;
+ begin
+ if On then
+ Err := wstandout (Win);
+ else
+ Err := wstandend (Win);
+ end if;
+ if Err = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Standout;
+
+ procedure Switch_Character_Attribute
+ (Win : in Window := Standard_Window;
+ Attr : in Character_Attribute_Set := Normal_Video;
+ On : in Boolean := True)
+ is
+ function Wattron (Win : Window;
+ C_Attr : C_AttrType) return C_Int;
+ pragma Import (C, Wattron, "wattr_on");
+ function Wattroff (Win : Window;
+ C_Attr : C_AttrType) return C_Int;
+ pragma Import (C, Wattroff, "wattr_off");
+ -- In Ada we use the On Boolean to control whether or not we want to
+ -- switch on or off the attributes in the set.
+ Err : C_Int;
+ AC : constant Attributed_Character := (Ch => Character'First,
+ Color => Color_Pair'First,
+ Attr => Attr);
+ begin
+ if On then
+ Err := Wattron (Win, AttrChar_To_AttrType (AC));
+ else
+ Err := Wattroff (Win, AttrChar_To_AttrType (AC));
+ end if;
+ if Err = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Switch_Character_Attribute;
+
+ procedure Set_Character_Attributes
+ (Win : in Window := Standard_Window;
+ Attr : in Character_Attribute_Set := Normal_Video;
+ Color : in Color_Pair := Color_Pair'First)
+ is
+ function Wattrset (Win : Window;
+ C_Attr : C_AttrType) return C_Int;
+ pragma Import (C, Wattrset, "wattrset"); -- ??? wattr_set
+ begin
+ if Wattrset (Win,
+ AttrChar_To_AttrType (Attributed_Character'
+ (Ch => Character'First,
+ Color => Color,
+ Attr => Attr))) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Set_Character_Attributes;
+
+ function Get_Character_Attribute (Win : Window := Standard_Window)
+ return Character_Attribute_Set
+ is
+ function Wattrget (Win : Window;
+ Atr : access C_AttrType;
+ Col : access C_Short;
+ Opt : System.Address) return C_Int;
+ pragma Import (C, Wattrget, "wattr_get");
+
+ Attr : aliased C_AttrType;
+ Col : aliased C_Short;
+ Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
+ System.Null_Address);
+ Ch : Attributed_Character;
+ begin
+ if Res = Curses_Ok then
+ Ch := AttrType_To_AttrChar (Attr);
+ return Ch.Attr;
+ else
+ raise Curses_Exception;
+ end if;
+ end Get_Character_Attribute;
+
+ function Get_Character_Attribute (Win : Window := Standard_Window)
+ return Color_Pair
+ is
+ function Wattrget (Win : Window;
+ Atr : access C_AttrType;
+ Col : access C_Short;
+ Opt : System.Address) return C_Int;
+ pragma Import (C, Wattrget, "wattr_get");
+
+ Attr : aliased C_AttrType;
+ Col : aliased C_Short;
+ Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
+ System.Null_Address);
+ Ch : Attributed_Character;
+ begin
+ if Res = Curses_Ok then
+ Ch := AttrType_To_AttrChar (Attr);
+ return Ch.Color;
+ else
+ raise Curses_Exception;
+ end if;
+ end Get_Character_Attribute;
+
+ procedure Set_Color (Win : in Window := Standard_Window;
+ Pair : in Color_Pair)
+ is
+ function Wset_Color (Win : Window;
+ Color : C_Short;
+ Opts : C_Void_Ptr) return C_Int;
+ pragma Import (C, Wset_Color, "wcolor_set");
+ begin
+ if Wset_Color (Win,
+ C_Short (Pair),
+ C_Void_Ptr (System.Null_Address)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Set_Color;
+
+ procedure Change_Attributes
+ (Win : in Window := Standard_Window;
+ Count : in Integer := -1;
+ Attr : in Character_Attribute_Set := Normal_Video;
+ Color : in Color_Pair := Color_Pair'First)
+ is
+ function Wchgat (Win : Window;
+ Cnt : C_Int;
+ Attr : C_AttrType;
+ Color : C_Short;
+ Opts : System.Address := System.Null_Address)
+ return C_Int;
+ pragma Import (C, Wchgat, "wchgat");
+
+ Ch : constant Attributed_Character :=
+ (Ch => Character'First, Color => Color_Pair'First, Attr => Attr);
+ begin
+ if Wchgat (Win, C_Int (Count), AttrChar_To_AttrType (Ch),
+ C_Short (Color)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Change_Attributes;
+
+ procedure Change_Attributes
+ (Win : in Window := Standard_Window;
+ Line : in Line_Position := Line_Position'First;
+ Column : in Column_Position := Column_Position'First;
+ Count : in Integer := -1;
+ Attr : in Character_Attribute_Set := Normal_Video;
+ Color : in Color_Pair := Color_Pair'First)
+ is
+ begin
+ Move_Cursor (Win, Line, Column);
+ Change_Attributes (Win, Count, Attr, Color);
+ end Change_Attributes;
+------------------------------------------------------------------------------
+ procedure Beep
+ is
+ function Beeper return C_Int;
+ pragma Import (C, Beeper, "beep");
+ begin
+ if Beeper = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Beep;
+
+ procedure Flash_Screen
+ is
+ function Flash return C_Int;
+ pragma Import (C, Flash, "flash");
+ begin
+ if Flash = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Flash_Screen;
+------------------------------------------------------------------------------
+ procedure Set_Cbreak_Mode (SwitchOn : in Boolean := True)
+ is
+ function Cbreak return C_Int;
+ pragma Import (C, Cbreak, "cbreak");
+ function NoCbreak return C_Int;
+ pragma Import (C, NoCbreak, "nocbreak");
+
+ Err : C_Int;
+ begin
+ if SwitchOn then
+ Err := Cbreak;
+ else
+ Err := NoCbreak;
+ end if;
+ if Err = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Set_Cbreak_Mode;
+
+ procedure Set_Raw_Mode (SwitchOn : in Boolean := True)
+ is
+ function Raw return C_Int;
+ pragma Import (C, Raw, "raw");
+ function NoRaw return C_Int;
+ pragma Import (C, NoRaw, "noraw");
+
+ Err : C_Int;
+ begin
+ if SwitchOn then
+ Err := Raw;
+ else
+ Err := NoRaw;
+ end if;
+ if Err = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Set_Raw_Mode;
+
+ procedure Set_Echo_Mode (SwitchOn : in Boolean := True)
+ is
+ function Echo return C_Int;
+ pragma Import (C, Echo, "echo");
+ function NoEcho return C_Int;
+ pragma Import (C, NoEcho, "noecho");
+
+ Err : C_Int;
+ begin
+ if SwitchOn then
+ Err := Echo;
+ else
+ Err := NoEcho;
+ end if;
+ if Err = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Set_Echo_Mode;
+
+ procedure Set_Meta_Mode (Win : in Window := Standard_Window;
+ SwitchOn : in Boolean := True)
+ is
+ function Meta (W : Window; Mode : Curses_Bool) return C_Int;
+ pragma Import (C, Meta, "meta");
+ begin
+ if Meta (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Set_Meta_Mode;
+
+ procedure Set_KeyPad_Mode (Win : in Window := Standard_Window;
+ SwitchOn : in Boolean := True)
+ is
+ function Keypad (W : Window; Mode : Curses_Bool) return C_Int;
+ pragma Import (C, Keypad, "keypad");
+ begin
+ if Keypad (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Set_KeyPad_Mode;
+
+ function Get_KeyPad_Mode (Win : in Window := Standard_Window)
+ return Boolean
+ is
+ function Is_Keypad (W : Window) return Curses_Bool;
+ pragma Import (C, Is_Keypad, "is_keypad");
+ begin
+ return (Is_Keypad (Win) /= Curses_Bool_False);
+ end Get_KeyPad_Mode;
+
+ procedure Half_Delay (Amount : in Half_Delay_Amount)
+ is
+ function Halfdelay (Amount : C_Int) return C_Int;
+ pragma Import (C, Halfdelay, "halfdelay");
+ begin
+ if Halfdelay (C_Int (Amount)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Half_Delay;
+
+ procedure Set_Flush_On_Interrupt_Mode
+ (Win : in Window := Standard_Window;
+ Mode : in Boolean := True)
+ is
+ function Intrflush (Win : Window; Mode : Curses_Bool) return C_Int;
+ pragma Import (C, Intrflush, "intrflush");
+ begin
+ if Intrflush (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Set_Flush_On_Interrupt_Mode;
+
+ procedure Set_Queue_Interrupt_Mode
+ (Win : in Window := Standard_Window;
+ Flush : in Boolean := True)
+ is
+ procedure Qiflush;
+ pragma Import (C, Qiflush, "qiflush");
+ procedure No_Qiflush;
+ pragma Import (C, No_Qiflush, "noqiflush");
+ begin
+ if Win = Null_Window then
+ raise Curses_Exception;
+ end if;
+ if Flush then
+ Qiflush;
+ else
+ No_Qiflush;
+ end if;
+ end Set_Queue_Interrupt_Mode;
+
+ procedure Set_NoDelay_Mode
+ (Win : in Window := Standard_Window;
+ Mode : in Boolean := False)
+ is
+ function Nodelay (Win : Window; Mode : Curses_Bool) return C_Int;
+ pragma Import (C, Nodelay, "nodelay");
+ begin
+ if Nodelay (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Set_NoDelay_Mode;
+
+ procedure Set_Timeout_Mode (Win : in Window := Standard_Window;
+ Mode : in Timeout_Mode;
+ Amount : in Natural)
+ is
+ procedure Wtimeout (Win : Window; Amount : C_Int);
+ pragma Import (C, Wtimeout, "wtimeout");
+
+ Time : C_Int;
+ begin
+ case Mode is
+ when Blocking => Time := -1;
+ when Non_Blocking => Time := 0;
+ when Delayed =>
+ if Amount = 0 then
+ raise Constraint_Error;
+ end if;
+ Time := C_Int (Amount);
+ end case;
+ Wtimeout (Win, Time);
+ end Set_Timeout_Mode;
+
+ procedure Set_Escape_Timer_Mode
+ (Win : in Window := Standard_Window;
+ Timer_Off : in Boolean := False)
+ is
+ function Notimeout (Win : Window; Mode : Curses_Bool) return C_Int;
+ pragma Import (C, Notimeout, "notimeout");
+ begin
+ if Notimeout (Win, Curses_Bool (Boolean'Pos (Timer_Off)))
+ = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Set_Escape_Timer_Mode;
+
+------------------------------------------------------------------------------
+ procedure Set_NL_Mode (SwitchOn : in Boolean := True)
+ is
+ function NL return C_Int;
+ pragma Import (C, NL, "nl");
+ function NoNL return C_Int;
+ pragma Import (C, NoNL, "nonl");
+
+ Err : C_Int;
+ begin
+ if SwitchOn then
+ Err := NL;
+ else
+ Err := NoNL;
+ end if;
+ if Err = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Set_NL_Mode;
+
+ procedure Clear_On_Next_Update
+ (Win : in Window := Standard_Window;
+ Do_Clear : in Boolean := True)
+ is
+ function Clear_Ok (W : Window; Flag : Curses_Bool) return C_Int;
+ pragma Import (C, Clear_Ok, "clearok");
+ begin
+ if Clear_Ok (Win, Curses_Bool (Boolean'Pos (Do_Clear))) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Clear_On_Next_Update;
+
+ procedure Use_Insert_Delete_Line
+ (Win : in Window := Standard_Window;
+ Do_Idl : in Boolean := True)
+ is
+ function IDL_Ok (W : Window; Flag : Curses_Bool) return C_Int;
+ pragma Import (C, IDL_Ok, "idlok");
+ begin
+ if IDL_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idl))) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Use_Insert_Delete_Line;
+
+ procedure Use_Insert_Delete_Character
+ (Win : in Window := Standard_Window;
+ Do_Idc : in Boolean := True)
+ is
+ procedure IDC_Ok (W : Window; Flag : Curses_Bool);
+ pragma Import (C, IDC_Ok, "idcok");
+ begin
+ IDC_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idc)));
+ end Use_Insert_Delete_Character;
+
+ procedure Leave_Cursor_After_Update
+ (Win : in Window := Standard_Window;
+ Do_Leave : in Boolean := True)
+ is
+ function Leave_Ok (W : Window; Flag : Curses_Bool) return C_Int;
+ pragma Import (C, Leave_Ok, "leaveok");
+ begin
+ if Leave_Ok (Win, Curses_Bool (Boolean'Pos (Do_Leave))) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Leave_Cursor_After_Update;
+
+ procedure Immediate_Update_Mode
+ (Win : in Window := Standard_Window;
+ Mode : in Boolean := False)
+ is
+ procedure Immedok (Win : Window; Mode : Curses_Bool);
+ pragma Import (C, Immedok, "immedok");
+ begin
+ Immedok (Win, Curses_Bool (Boolean'Pos (Mode)));
+ end Immediate_Update_Mode;
+
+ procedure Allow_Scrolling
+ (Win : in Window := Standard_Window;
+ Mode : in Boolean := False)
+ is
+ function Scrollok (Win : Window; Mode : Curses_Bool) return C_Int;
+ pragma Import (C, Scrollok, "scrollok");
+ begin
+ if Scrollok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Allow_Scrolling;
+
+ function Scrolling_Allowed (Win : Window := Standard_Window)
+ return Boolean
+ is
+ function Is_Scroll_Ok (W : Window) return Curses_Bool;
+ pragma Import (C, Is_Scroll_Ok, "is_scrollok");
+ begin
+ return (Is_Scroll_Ok (Win) /= Curses_Bool_False);
+ end Scrolling_Allowed;
+
+ procedure Set_Scroll_Region
+ (Win : in Window := Standard_Window;
+ Top_Line : in Line_Position;
+ Bottom_Line : in Line_Position)
+ is
+ function Wsetscrreg (Win : Window;
+ Lin : C_Int;
+ Col : C_Int) return C_Int;
+ pragma Import (C, Wsetscrreg, "wsetscrreg");
+ begin
+ if Wsetscrreg (Win, C_Int (Top_Line), C_Int (Bottom_Line))
+ = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Set_Scroll_Region;
+------------------------------------------------------------------------------
+ procedure Update_Screen
+ is
+ function Do_Update return C_Int;
+ pragma Import (C, Do_Update, "doupdate");
+ begin
+ if Do_Update = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Update_Screen;
+
+ procedure Refresh (Win : in Window := Standard_Window)
+ is
+ function Wrefresh (W : Window) return C_Int;
+ pragma Import (C, Wrefresh, "wrefresh");
+ begin
+ if Wrefresh (Win) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Refresh;
+
+ procedure Refresh_Without_Update
+ (Win : in Window := Standard_Window)
+ is
+ function Wnoutrefresh (W : Window) return C_Int;
+ pragma Import (C, Wnoutrefresh, "wnoutrefresh");
+ begin
+ if Wnoutrefresh (Win) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Refresh_Without_Update;
+
+ procedure Redraw (Win : in Window := Standard_Window)
+ is
+ function Redrawwin (Win : Window) return C_Int;
+ pragma Import (C, Redrawwin, "redrawwin");
+ begin
+ if Redrawwin (Win) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Redraw;
+
+ procedure Redraw
+ (Win : in Window := Standard_Window;
+ Begin_Line : in Line_Position;
+ Line_Count : in Positive)
+ is
+ function Wredrawln (Win : Window; First : C_Int; Cnt : C_Int)
+ return C_Int;
+ pragma Import (C, Wredrawln, "wredrawln");
+ begin
+ if Wredrawln (Win,
+ C_Int (Begin_Line),
+ C_Int (Line_Count)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Redraw;
+
+------------------------------------------------------------------------------
+ procedure Erase (Win : in Window := Standard_Window)
+ is
+ function Werase (W : Window) return C_Int;
+ pragma Import (C, Werase, "werase");
+ begin
+ if Werase (Win) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Erase;
+
+ procedure Clear (Win : in Window := Standard_Window)
+ is
+ function Wclear (W : Window) return C_Int;
+ pragma Import (C, Wclear, "wclear");
+ begin
+ if Wclear (Win) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Clear;
+
+ procedure Clear_To_End_Of_Screen (Win : in Window := Standard_Window)
+ is
+ function Wclearbot (W : Window) return C_Int;
+ pragma Import (C, Wclearbot, "wclrtobot");
+ begin
+ if Wclearbot (Win) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Clear_To_End_Of_Screen;
+
+ procedure Clear_To_End_Of_Line (Win : in Window := Standard_Window)
+ is
+ function Wcleareol (W : Window) return C_Int;
+ pragma Import (C, Wcleareol, "wclrtoeol");
+ begin
+ if Wcleareol (Win) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Clear_To_End_Of_Line;
+------------------------------------------------------------------------------
+ procedure Set_Background
+ (Win : in Window := Standard_Window;
+ Ch : in Attributed_Character)
+ is
+ procedure WBackground (W : in Window; Ch : in C_Chtype);
+ pragma Import (C, WBackground, "wbkgdset");
+ begin
+ WBackground (Win, AttrChar_To_Chtype (Ch));
+ end Set_Background;
+
+ procedure Change_Background
+ (Win : in Window := Standard_Window;
+ Ch : in Attributed_Character)
+ is
+ function WChangeBkgd (W : Window; Ch : C_Chtype) return C_Int;
+ pragma Import (C, WChangeBkgd, "wbkgd");
+ begin
+ if WChangeBkgd (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Change_Background;
+
+ function Get_Background (Win : Window := Standard_Window)
+ return Attributed_Character
+ is
+ function Wgetbkgd (Win : Window) return C_Chtype;
+ pragma Import (C, Wgetbkgd, "getbkgd");
+ begin
+ return Chtype_To_AttrChar (Wgetbkgd (Win));
+ end Get_Background;
+------------------------------------------------------------------------------
+ procedure Change_Lines_Status (Win : in Window := Standard_Window;
+ Start : in Line_Position;
+ Count : in Positive;
+ State : in Boolean)
+ is
+ function Wtouchln (Win : Window;
+ Sta : C_Int;
+ Cnt : C_Int;
+ Chg : C_Int) return C_Int;
+ pragma Import (C, Wtouchln, "wtouchln");
+ begin
+ if Wtouchln (Win, C_Int (Start), C_Int (Count),
+ C_Int (Boolean'Pos (State))) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Change_Lines_Status;
+
+ procedure Touch (Win : in Window := Standard_Window)
+ is
+ Y : Line_Position;
+ X : Column_Position;
+ begin
+ Get_Size (Win, Y, X);
+ Change_Lines_Status (Win, 0, Positive (Y), True);
+ end Touch;
+
+ procedure Untouch (Win : in Window := Standard_Window)
+ is
+ Y : Line_Position;
+ X : Column_Position;
+ begin
+ Get_Size (Win, Y, X);
+ Change_Lines_Status (Win, 0, Positive (Y), False);
+ end Untouch;
+
+ procedure Touch (Win : in Window := Standard_Window;
+ Start : in Line_Position;
+ Count : in Positive)
+ is
+ begin
+ Change_Lines_Status (Win, Start, Count, True);
+ end Touch;
+
+ function Is_Touched
+ (Win : Window := Standard_Window;
+ Line : Line_Position) return Boolean
+ is
+ function WLineTouched (W : Window; L : C_Int) return Curses_Bool;
+ pragma Import (C, WLineTouched, "is_linetouched");
+ begin
+ if WLineTouched (Win, C_Int (Line)) = Curses_Bool_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Is_Touched;
+
+ function Is_Touched
+ (Win : Window := Standard_Window) return Boolean
+ is
+ function WWinTouched (W : Window) return Curses_Bool;
+ pragma Import (C, WWinTouched, "is_wintouched");
+ begin
+ if WWinTouched (Win) = Curses_Bool_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Is_Touched;
+------------------------------------------------------------------------------
+ procedure Copy
+ (Source_Window : in Window;
+ Destination_Window : in Window;
+ Source_Top_Row : in Line_Position;
+ Source_Left_Column : in Column_Position;
+ Destination_Top_Row : in Line_Position;
+ Destination_Left_Column : in Column_Position;
+ Destination_Bottom_Row : in Line_Position;
+ Destination_Right_Column : in Column_Position;
+ Non_Destructive_Mode : in Boolean := True)
+ is
+ function Copywin (Src : Window;
+ Dst : Window;
+ Str : C_Int;
+ Slc : C_Int;
+ Dtr : C_Int;
+ Dlc : C_Int;
+ Dbr : C_Int;
+ Drc : C_Int;
+ Ndm : C_Int) return C_Int;
+ pragma Import (C, Copywin, "copywin");
+ begin
+ if Copywin (Source_Window,
+ Destination_Window,
+ C_Int (Source_Top_Row),
+ C_Int (Source_Left_Column),
+ C_Int (Destination_Top_Row),
+ C_Int (Destination_Left_Column),
+ C_Int (Destination_Bottom_Row),
+ C_Int (Destination_Right_Column),
+ Boolean'Pos (Non_Destructive_Mode)
+ ) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Copy;
+
+ procedure Overwrite
+ (Source_Window : in Window;
+ Destination_Window : in Window)
+ is
+ function Overwrite (Src : Window; Dst : Window) return C_Int;
+ pragma Import (C, Overwrite, "overwrite");
+ begin
+ if Overwrite (Source_Window, Destination_Window) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Overwrite;
+
+ procedure Overlay
+ (Source_Window : in Window;
+ Destination_Window : in Window)
+ is
+ function Overlay (Src : Window; Dst : Window) return C_Int;
+ pragma Import (C, Overlay, "overlay");
+ begin
+ if Overlay (Source_Window, Destination_Window) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Overlay;
+
+------------------------------------------------------------------------------
+ procedure Insert_Delete_Lines
+ (Win : in Window := Standard_Window;
+ Lines : in Integer := 1) -- default is to insert one line above
+ is
+ function Winsdelln (W : Window; N : C_Int) return C_Int;
+ pragma Import (C, Winsdelln, "winsdelln");
+ begin
+ if Winsdelln (Win, C_Int (Lines)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Insert_Delete_Lines;
+
+ procedure Delete_Line (Win : in Window := Standard_Window)
+ is
+ begin
+ Insert_Delete_Lines (Win, -1);
+ end Delete_Line;
+
+ procedure Insert_Line (Win : in Window := Standard_Window)
+ is
+ begin
+ Insert_Delete_Lines (Win, 1);
+ end Insert_Line;
+------------------------------------------------------------------------------
+
+ procedure Get_Size
+ (Win : in Window := Standard_Window;
+ Number_Of_Lines : out Line_Count;
+ Number_Of_Columns : out Column_Count)
+ is
+ function GetMaxY (W : Window) return C_Int;
+ pragma Import (C, GetMaxY, "getmaxy");
+
+ function GetMaxX (W : Window) return C_Int;
+ pragma Import (C, GetMaxX, "getmaxx");
+
+ Y : constant C_Int := GetMaxY (Win)
+ + C_Int (Offset_XY);
+ X : constant C_Int := GetMaxX (Win)
+ + C_Int (Offset_XY);
+ begin
+ Number_Of_Lines := Line_Count (Y);
+ Number_Of_Columns := Column_Count (X);
+ end Get_Size;
+
+ procedure Get_Window_Position
+ (Win : in Window := Standard_Window;
+ Top_Left_Line : out Line_Position;
+ Top_Left_Column : out Column_Position)
+ is
+ function GetBegY (W : Window) return C_Int;
+ pragma Import (C, GetBegY, "getbegy");
+
+ function GetBegX (W : Window) return C_Int;
+ pragma Import (C, GetBegX, "getbegx");
+
+ Y : constant C_Short := C_Short (GetBegY (Win));
+ X : constant C_Short := C_Short (GetBegX (Win));
+ begin
+ Top_Left_Line := Line_Position (Y);
+ Top_Left_Column := Column_Position (X);
+ end Get_Window_Position;
+
+ procedure Get_Cursor_Position
+ (Win : in Window := Standard_Window;
+ Line : out Line_Position;
+ Column : out Column_Position)
+ is
+ function GetCurY (W : Window) return C_Int;
+ pragma Import (C, GetCurY, "getcury");
+
+ function GetCurX (W : Window) return C_Int;
+ pragma Import (C, GetCurX, "getcurx");
+
+ Y : constant C_Short := C_Short (GetCurY (Win));
+ X : constant C_Short := C_Short (GetCurX (Win));
+ begin
+ Line := Line_Position (Y);
+ Column := Column_Position (X);
+ end Get_Cursor_Position;
+
+ procedure Get_Origin_Relative_To_Parent
+ (Win : in Window;
+ Top_Left_Line : out Line_Position;
+ Top_Left_Column : out Column_Position;
+ Is_Not_A_Subwindow : out Boolean)
+ is
+ function GetParY (W : Window) return C_Int;
+ pragma Import (C, GetParY, "getpary");
+
+ function GetParX (W : Window) return C_Int;
+ pragma Import (C, GetParX, "getparx");
+
+ Y : constant C_Int := GetParY (Win);
+ X : constant C_Int := GetParX (Win);
+ begin
+ if Y = -1 then
+ Top_Left_Line := Line_Position'Last;
+ Top_Left_Column := Column_Position'Last;
+ Is_Not_A_Subwindow := True;
+ else
+ Top_Left_Line := Line_Position (Y);
+ Top_Left_Column := Column_Position (X);
+ Is_Not_A_Subwindow := False;
+ end if;
+ end Get_Origin_Relative_To_Parent;
+------------------------------------------------------------------------------
+ function New_Pad (Lines : Line_Count;
+ Columns : Column_Count) return Window
+ is
+ function Newpad (Lines : C_Int; Columns : C_Int) return Window;
+ pragma Import (C, Newpad, "newpad");
+
+ W : Window;
+ begin
+ W := Newpad (C_Int (Lines), C_Int (Columns));
+ if W = Null_Window then
+ raise Curses_Exception;
+ end if;
+ return W;
+ end New_Pad;
+
+ function Sub_Pad
+ (Pad : Window;
+ Number_Of_Lines : Line_Count;
+ Number_Of_Columns : Column_Count;
+ First_Line_Position : Line_Position;
+ First_Column_Position : Column_Position) return Window
+ is
+ function Subpad
+ (Pad : Window;
+ Number_Of_Lines : C_Int;
+ Number_Of_Columns : C_Int;
+ First_Line_Position : C_Int;
+ First_Column_Position : C_Int) return Window;
+ pragma Import (C, Subpad, "subpad");
+
+ W : Window;
+ begin
+ W := Subpad (Pad,
+ C_Int (Number_Of_Lines),
+ C_Int (Number_Of_Columns),
+ C_Int (First_Line_Position),
+ C_Int (First_Column_Position));
+ if W = Null_Window then
+ raise Curses_Exception;
+ end if;
+ return W;
+ end Sub_Pad;
+
+ procedure Refresh
+ (Pad : in Window;
+ Source_Top_Row : in Line_Position;
+ Source_Left_Column : in Column_Position;
+ Destination_Top_Row : in Line_Position;
+ Destination_Left_Column : in Column_Position;
+ Destination_Bottom_Row : in Line_Position;
+ Destination_Right_Column : in Column_Position)
+ is
+ function Prefresh
+ (Pad : Window;
+ Source_Top_Row : C_Int;
+ Source_Left_Column : C_Int;
+ Destination_Top_Row : C_Int;
+ Destination_Left_Column : C_Int;
+ Destination_Bottom_Row : C_Int;
+ Destination_Right_Column : C_Int) return C_Int;
+ pragma Import (C, Prefresh, "prefresh");
+ begin
+ if Prefresh (Pad,
+ C_Int (Source_Top_Row),
+ C_Int (Source_Left_Column),
+ C_Int (Destination_Top_Row),
+ C_Int (Destination_Left_Column),
+ C_Int (Destination_Bottom_Row),
+ C_Int (Destination_Right_Column)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Refresh;
+
+ procedure Refresh_Without_Update
+ (Pad : in Window;
+ Source_Top_Row : in Line_Position;
+ Source_Left_Column : in Column_Position;
+ Destination_Top_Row : in Line_Position;
+ Destination_Left_Column : in Column_Position;
+ Destination_Bottom_Row : in Line_Position;
+ Destination_Right_Column : in Column_Position)
+ is
+ function Pnoutrefresh
+ (Pad : Window;
+ Source_Top_Row : C_Int;
+ Source_Left_Column : C_Int;
+ Destination_Top_Row : C_Int;
+ Destination_Left_Column : C_Int;
+ Destination_Bottom_Row : C_Int;
+ Destination_Right_Column : C_Int) return C_Int;
+ pragma Import (C, Pnoutrefresh, "pnoutrefresh");
+ begin
+ if Pnoutrefresh (Pad,
+ C_Int (Source_Top_Row),
+ C_Int (Source_Left_Column),
+ C_Int (Destination_Top_Row),
+ C_Int (Destination_Left_Column),
+ C_Int (Destination_Bottom_Row),
+ C_Int (Destination_Right_Column)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Refresh_Without_Update;
+
+ procedure Add_Character_To_Pad_And_Echo_It
+ (Pad : in Window;
+ Ch : in Attributed_Character)
+ is
+ function Pechochar (Pad : Window; Ch : C_Chtype)
+ return C_Int;
+ pragma Import (C, Pechochar, "pechochar");
+ begin
+ if Pechochar (Pad, AttrChar_To_Chtype (Ch)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Add_Character_To_Pad_And_Echo_It;
+
+ procedure Add_Character_To_Pad_And_Echo_It
+ (Pad : in Window;
+ Ch : in Character)
+ is
+ begin
+ Add_Character_To_Pad_And_Echo_It
+ (Pad,
+ Attributed_Character'(Ch => Ch,
+ Color => Color_Pair'First,
+ Attr => Normal_Video));
+ end Add_Character_To_Pad_And_Echo_It;
+------------------------------------------------------------------------------
+ procedure Scroll (Win : in Window := Standard_Window;
+ Amount : in Integer := 1)
+ is
+ function Wscrl (Win : Window; N : C_Int) return C_Int;
+ pragma Import (C, Wscrl, "wscrl");
+
+ begin
+ if Wscrl (Win, C_Int (Amount)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Scroll;
+
+------------------------------------------------------------------------------
+ procedure Delete_Character (Win : in Window := Standard_Window)
+ is
+ function Wdelch (Win : Window) return C_Int;
+ pragma Import (C, Wdelch, "wdelch");
+ begin
+ if Wdelch (Win) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Delete_Character;
+
+ procedure Delete_Character
+ (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position)
+ is
+ function Mvwdelch (Win : Window;
+ Lin : C_Int;
+ Col : C_Int) return C_Int;
+ pragma Import (C, Mvwdelch, "mvwdelch");
+ begin
+ if Mvwdelch (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Delete_Character;
+------------------------------------------------------------------------------
+ function Peek (Win : Window := Standard_Window)
+ return Attributed_Character
+ is
+ function Winch (Win : Window) return C_Chtype;
+ pragma Import (C, Winch, "winch");
+ begin
+ return Chtype_To_AttrChar (Winch (Win));
+ end Peek;
+
+ function Peek
+ (Win : Window := Standard_Window;
+ Line : Line_Position;
+ Column : Column_Position) return Attributed_Character
+ is
+ function Mvwinch (Win : Window;
+ Lin : C_Int;
+ Col : C_Int) return C_Chtype;
+ pragma Import (C, Mvwinch, "mvwinch");
+ begin
+ return Chtype_To_AttrChar (Mvwinch (Win, C_Int (Line), C_Int (Column)));
+ end Peek;
+------------------------------------------------------------------------------
+ procedure Insert (Win : in Window := Standard_Window;
+ Ch : in Attributed_Character)
+ is
+ function Winsch (Win : Window; Ch : C_Chtype) return C_Int;
+ pragma Import (C, Winsch, "winsch");
+ begin
+ if Winsch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Insert;
+
+ procedure Insert
+ (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position;
+ Ch : in Attributed_Character)
+ is
+ function Mvwinsch (Win : Window;
+ Lin : C_Int;
+ Col : C_Int;
+ Ch : C_Chtype) return C_Int;
+ pragma Import (C, Mvwinsch, "mvwinsch");
+ begin
+ if Mvwinsch (Win,
+ C_Int (Line),
+ C_Int (Column),
+ AttrChar_To_Chtype (Ch)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Insert;
+------------------------------------------------------------------------------
+ procedure Insert (Win : in Window := Standard_Window;
+ Str : in String;
+ Len : in Integer := -1)
+ is
+ function Winsnstr (Win : Window;
+ Str : char_array;
+ Len : Integer := -1) return C_Int;
+ pragma Import (C, Winsnstr, "winsnstr");
+
+ Txt : char_array (0 .. Str'Length);
+ Length : size_t;
+ begin
+ To_C (Str, Txt, Length);
+ if Winsnstr (Win, Txt, Len) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Insert;
+
+ procedure Insert
+ (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position;
+ Str : in String;
+ Len : in Integer := -1)
+ is
+ function Mvwinsnstr (Win : Window;
+ Line : C_Int;
+ Column : C_Int;
+ Str : char_array;
+ Len : C_Int) return C_Int;
+ pragma Import (C, Mvwinsnstr, "mvwinsnstr");
+
+ Txt : char_array (0 .. Str'Length);
+ Length : size_t;
+ begin
+ To_C (Str, Txt, Length);
+ if Mvwinsnstr (Win, C_Int (Line), C_Int (Column), Txt, C_Int (Len))
+ = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Insert;
+------------------------------------------------------------------------------
+ procedure Peek (Win : in Window := Standard_Window;
+ Str : out String;
+ Len : in Integer := -1)
+ is
+ function Winnstr (Win : Window;
+ Str : char_array;
+ Len : C_Int) return C_Int;
+ pragma Import (C, Winnstr, "winnstr");
+
+ N : Integer := Len;
+ Txt : char_array (0 .. Str'Length);
+ Cnt : Natural;
+ begin
+ if N < 0 then
+ N := Str'Length;
+ end if;
+ if N > Str'Length then
+ raise Constraint_Error;
+ end if;
+ Txt (0) := Interfaces.C.char'First;
+ if Winnstr (Win, Txt, C_Int (N)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ To_Ada (Txt, Str, Cnt, True);
+ if Cnt < Str'Length then
+ Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
+ end if;
+ end Peek;
+
+ procedure Peek
+ (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position;
+ Str : out String;
+ Len : in Integer := -1)
+ is
+ begin
+ Move_Cursor (Win, Line, Column);
+ Peek (Win, Str, Len);
+ end Peek;
+------------------------------------------------------------------------------
+ procedure Peek
+ (Win : in Window := Standard_Window;
+ Str : out Attributed_String;
+ Len : in Integer := -1)
+ is
+ function Winchnstr (Win : Window;
+ Str : chtype_array; -- out
+ Len : C_Int) return C_Int;
+ pragma Import (C, Winchnstr, "winchnstr");
+
+ N : Integer := Len;
+ Txt : constant chtype_array (0 .. Str'Length)
+ := (0 => Default_Character);
+ Cnt : Natural := 0;
+ begin
+ if N < 0 then
+ N := Str'Length;
+ end if;
+ if N > Str'Length then
+ raise Constraint_Error;
+ end if;
+ if Winchnstr (Win, Txt, C_Int (N)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ for To in Str'Range loop
+ exit when Txt (size_t (Cnt)) = Default_Character;
+ Str (To) := Txt (size_t (Cnt));
+ Cnt := Cnt + 1;
+ end loop;
+ if Cnt < Str'Length then
+ Str ((Str'First + Cnt) .. Str'Last) :=
+ (others => (Ch => ' ',
+ Color => Color_Pair'First,
+ Attr => Normal_Video));
+ end if;
+ end Peek;
+
+ procedure Peek
+ (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position;
+ Str : out Attributed_String;
+ Len : in Integer := -1)
+ is
+ begin
+ Move_Cursor (Win, Line, Column);
+ Peek (Win, Str, Len);
+ end Peek;
+------------------------------------------------------------------------------
+ procedure Get (Win : in Window := Standard_Window;
+ Str : out String;
+ Len : in Integer := -1)
+ is
+ function Wgetnstr (Win : Window;
+ Str : char_array;
+ Len : C_Int) return C_Int;
+ pragma Import (C, Wgetnstr, "wgetnstr");
+
+ N : Integer := Len;
+ Txt : char_array (0 .. Str'Length);
+ Cnt : Natural;
+ begin
+ if N < 0 then
+ N := Str'Length;
+ end if;
+ if N > Str'Length then
+ raise Constraint_Error;
+ end if;
+ Txt (0) := Interfaces.C.char'First;
+ if Wgetnstr (Win, Txt, C_Int (N)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ To_Ada (Txt, Str, Cnt, True);
+ if Cnt < Str'Length then
+ Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
+ end if;
+ end Get;
+
+ procedure Get
+ (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position;
+ Str : out String;
+ Len : in Integer := -1)
+ is
+ begin
+ Move_Cursor (Win, Line, Column);
+ Get (Win, Str, Len);
+ end Get;
+------------------------------------------------------------------------------
+ procedure Init_Soft_Label_Keys
+ (Format : in Soft_Label_Key_Format := Three_Two_Three)
+ is
+ function Slk_Init (Fmt : C_Int) return C_Int;
+ pragma Import (C, Slk_Init, "slk_init");
+ begin
+ if Slk_Init (Soft_Label_Key_Format'Pos (Format)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Init_Soft_Label_Keys;
+
+ procedure Set_Soft_Label_Key (Label : in Label_Number;
+ Text : in String;
+ Fmt : in Label_Justification := Left)
+ is
+ function Slk_Set (Label : C_Int;
+ Txt : char_array;
+ Fmt : C_Int) return C_Int;
+ pragma Import (C, Slk_Set, "slk_set");
+
+ Txt : char_array (0 .. Text'Length);
+ Len : size_t;
+ begin
+ To_C (Text, Txt, Len);
+ if Slk_Set (C_Int (Label), Txt,
+ C_Int (Label_Justification'Pos (Fmt))) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Set_Soft_Label_Key;
+
+ procedure Refresh_Soft_Label_Keys
+ is
+ function Slk_Refresh return C_Int;
+ pragma Import (C, Slk_Refresh, "slk_refresh");
+ begin
+ if Slk_Refresh = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Refresh_Soft_Label_Keys;
+
+ procedure Refresh_Soft_Label_Keys_Without_Update
+ is
+ function Slk_Noutrefresh return C_Int;
+ pragma Import (C, Slk_Noutrefresh, "slk_noutrefresh");
+ begin
+ if Slk_Noutrefresh = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Refresh_Soft_Label_Keys_Without_Update;
+
+ procedure Get_Soft_Label_Key (Label : in Label_Number;
+ Text : out String)
+ is
+ function Slk_Label (Label : C_Int) return chars_ptr;
+ pragma Import (C, Slk_Label, "slk_label");
+ begin
+ Fill_String (Slk_Label (C_Int (Label)), Text);
+ end Get_Soft_Label_Key;
+
+ function Get_Soft_Label_Key (Label : in Label_Number) return String
+ is
+ function Slk_Label (Label : C_Int) return chars_ptr;
+ pragma Import (C, Slk_Label, "slk_label");
+ begin
+ return Fill_String (Slk_Label (C_Int (Label)));
+ end Get_Soft_Label_Key;
+
+ procedure Clear_Soft_Label_Keys
+ is
+ function Slk_Clear return C_Int;
+ pragma Import (C, Slk_Clear, "slk_clear");
+ begin
+ if Slk_Clear = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Clear_Soft_Label_Keys;
+
+ procedure Restore_Soft_Label_Keys
+ is
+ function Slk_Restore return C_Int;
+ pragma Import (C, Slk_Restore, "slk_restore");
+ begin
+ if Slk_Restore = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Restore_Soft_Label_Keys;
+
+ procedure Touch_Soft_Label_Keys
+ is
+ function Slk_Touch return C_Int;
+ pragma Import (C, Slk_Touch, "slk_touch");
+ begin
+ if Slk_Touch = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Touch_Soft_Label_Keys;
+
+ procedure Switch_Soft_Label_Key_Attributes
+ (Attr : in Character_Attribute_Set;
+ On : in Boolean := True)
+ is
+ function Slk_Attron (Ch : C_Chtype) return C_Int;
+ pragma Import (C, Slk_Attron, "slk_attron");
+ function Slk_Attroff (Ch : C_Chtype) return C_Int;
+ pragma Import (C, Slk_Attroff, "slk_attroff");
+
+ Err : C_Int;
+ Ch : constant Attributed_Character := (Ch => Character'First,
+ Attr => Attr,
+ Color => Color_Pair'First);
+ begin
+ if On then
+ Err := Slk_Attron (AttrChar_To_Chtype (Ch));
+ else
+ Err := Slk_Attroff (AttrChar_To_Chtype (Ch));
+ end if;
+ if Err = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Switch_Soft_Label_Key_Attributes;
+
+ procedure Set_Soft_Label_Key_Attributes
+ (Attr : in Character_Attribute_Set := Normal_Video;
+ Color : in Color_Pair := Color_Pair'First)
+ is
+ function Slk_Attrset (Ch : C_Chtype) return C_Int;
+ pragma Import (C, Slk_Attrset, "slk_attrset");
+
+ Ch : constant Attributed_Character := (Ch => Character'First,
+ Attr => Attr,
+ Color => Color);
+ begin
+ if Slk_Attrset (AttrChar_To_Chtype (Ch)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Set_Soft_Label_Key_Attributes;
+
+ function Get_Soft_Label_Key_Attributes return Character_Attribute_Set
+ is
+ function Slk_Attr return C_Chtype;
+ pragma Import (C, Slk_Attr, "slk_attr");
+
+ Attr : constant C_Chtype := Slk_Attr;
+ begin
+ return Chtype_To_AttrChar (Attr).Attr;
+ end Get_Soft_Label_Key_Attributes;
+
+ function Get_Soft_Label_Key_Attributes return Color_Pair
+ is
+ function Slk_Attr return C_Chtype;
+ pragma Import (C, Slk_Attr, "slk_attr");
+
+ Attr : constant C_Chtype := Slk_Attr;
+ begin
+ return Chtype_To_AttrChar (Attr).Color;
+ end Get_Soft_Label_Key_Attributes;
+
+ procedure Set_Soft_Label_Key_Color (Pair : in Color_Pair)
+ is
+ function Slk_Color (Color : in C_Short) return C_Int;
+ pragma Import (C, Slk_Color, "slk_color");
+ begin
+ if Slk_Color (C_Short (Pair)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Set_Soft_Label_Key_Color;
+
+------------------------------------------------------------------------------
+ procedure Enable_Key (Key : in Special_Key_Code;
+ Enable : in Boolean := True)
+ is
+ function Keyok (Keycode : C_Int;
+ On_Off : Curses_Bool) return C_Int;
+ pragma Import (C, Keyok, "keyok");
+ begin
+ if Keyok (C_Int (Key), Curses_Bool (Boolean'Pos (Enable)))
+ = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Enable_Key;
+------------------------------------------------------------------------------
+ procedure Define_Key (Definition : in String;
+ Key : in Special_Key_Code)
+ is
+ function Defkey (Def : char_array;
+ Key : C_Int) return C_Int;
+ pragma Import (C, Defkey, "define_key");
+
+ Txt : char_array (0 .. Definition'Length);
+ Length : size_t;
+ begin
+ To_C (Definition, Txt, Length);
+ if Defkey (Txt, C_Int (Key)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Define_Key;
+------------------------------------------------------------------------------
+ procedure Un_Control (Ch : in Attributed_Character;
+ Str : out String)
+ is
+ function Unctrl (Ch : C_Chtype) return chars_ptr;
+ pragma Import (C, Unctrl, "unctrl");
+ begin
+ Fill_String (Unctrl (AttrChar_To_Chtype (Ch)), Str);
+ end Un_Control;
+
+ function Un_Control (Ch : in Attributed_Character) return String
+ is
+ function Unctrl (Ch : C_Chtype) return chars_ptr;
+ pragma Import (C, Unctrl, "unctrl");
+ begin
+ return Fill_String (Unctrl (AttrChar_To_Chtype (Ch)));
+ end Un_Control;
+
+ procedure Delay_Output (Msecs : in Natural)
+ is
+ function Delayoutput (Msecs : C_Int) return C_Int;
+ pragma Import (C, Delayoutput, "delay_output");
+ begin
+ if Delayoutput (C_Int (Msecs)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Delay_Output;
+
+ procedure Flush_Input
+ is
+ function Flushinp return C_Int;
+ pragma Import (C, Flushinp, "flushinp");
+ begin
+ if Flushinp = Curses_Err then -- docu says that never happens, but...
+ raise Curses_Exception;
+ end if;
+ end Flush_Input;
+------------------------------------------------------------------------------
+ function Baudrate return Natural
+ is
+ function Baud return C_Int;
+ pragma Import (C, Baud, "baudrate");
+ begin
+ return Natural (Baud);
+ end Baudrate;
+
+ function Erase_Character return Character
+ is
+ function Erasechar return C_Int;
+ pragma Import (C, Erasechar, "erasechar");
+ begin
+ return Character'Val (Erasechar);
+ end Erase_Character;
+
+ function Kill_Character return Character
+ is
+ function Killchar return C_Int;
+ pragma Import (C, Killchar, "killchar");
+ begin
+ return Character'Val (Killchar);
+ end Kill_Character;
+
+ function Has_Insert_Character return Boolean
+ is
+ function Has_Ic return Curses_Bool;
+ pragma Import (C, Has_Ic, "has_ic");
+ begin
+ if Has_Ic = Curses_Bool_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Has_Insert_Character;
+
+ function Has_Insert_Line return Boolean
+ is
+ function Has_Il return Curses_Bool;
+ pragma Import (C, Has_Il, "has_il");
+ begin
+ if Has_Il = Curses_Bool_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Has_Insert_Line;
+
+ function Supported_Attributes return Character_Attribute_Set
+ is
+ function Termattrs return C_Chtype;
+ pragma Import (C, Termattrs, "termattrs");
+
+ Ch : constant Attributed_Character := Chtype_To_AttrChar (Termattrs);
+ begin
+ return Ch.Attr;
+ end Supported_Attributes;
+
+ procedure Long_Name (Name : out String)
+ is
+ function Longname return chars_ptr;
+ pragma Import (C, Longname, "longname");
+ begin
+ Fill_String (Longname, Name);
+ end Long_Name;
+
+ function Long_Name return String
+ is
+ function Longname return chars_ptr;
+ pragma Import (C, Longname, "longname");
+ begin
+ return Fill_String (Longname);
+ end Long_Name;
+
+ procedure Terminal_Name (Name : out String)
+ is
+ function Termname return chars_ptr;
+ pragma Import (C, Termname, "termname");
+ begin
+ Fill_String (Termname, Name);
+ end Terminal_Name;
+
+ function Terminal_Name return String
+ is
+ function Termname return chars_ptr;
+ pragma Import (C, Termname, "termname");
+ begin
+ return Fill_String (Termname);
+ end Terminal_Name;
+------------------------------------------------------------------------------
+ procedure Init_Pair (Pair : in Redefinable_Color_Pair;
+ Fore : in Color_Number;
+ Back : in Color_Number)
+ is
+ function Initpair (Pair : C_Short;
+ Fore : C_Short;
+ Back : C_Short) return C_Int;
+ pragma Import (C, Initpair, "init_pair");
+ begin
+ if Integer (Pair) >= Number_Of_Color_Pairs then
+ raise Constraint_Error;
+ end if;
+ if Integer (Fore) >= Number_Of_Colors or else
+ Integer (Back) >= Number_Of_Colors then
+ raise Constraint_Error;
+ end if;
+ if Initpair (C_Short (Pair), C_Short (Fore), C_Short (Back))
+ = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Init_Pair;
+
+ procedure Pair_Content (Pair : in Color_Pair;
+ Fore : out Color_Number;
+ Back : out Color_Number)
+ is
+ type C_Short_Access is access all C_Short;
+ function Paircontent (Pair : C_Short;
+ Fp : C_Short_Access;
+ Bp : C_Short_Access) return C_Int;
+ pragma Import (C, Paircontent, "pair_content");
+
+ F, B : aliased C_Short;
+ begin
+ if Paircontent (C_Short (Pair), F'Access, B'Access) = Curses_Err then
+ raise Curses_Exception;
+ else
+ Fore := Color_Number (F);
+ Back := Color_Number (B);
+ end if;
+ end Pair_Content;
+
+ function Has_Colors return Boolean
+ is
+ function Hascolors return Curses_Bool;
+ pragma Import (C, Hascolors, "has_colors");
+ begin
+ if Hascolors = Curses_Bool_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Has_Colors;
+
+ procedure Init_Color (Color : in Color_Number;
+ Red : in RGB_Value;
+ Green : in RGB_Value;
+ Blue : in RGB_Value)
+ is
+ function Initcolor (Col : C_Short;
+ Red : C_Short;
+ Green : C_Short;
+ Blue : C_Short) return C_Int;
+ pragma Import (C, Initcolor, "init_color");
+ begin
+ if Initcolor (C_Short (Color), C_Short (Red), C_Short (Green),
+ C_Short (Blue)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Init_Color;
+
+ function Can_Change_Color return Boolean
+ is
+ function Canchangecolor return Curses_Bool;
+ pragma Import (C, Canchangecolor, "can_change_color");
+ begin
+ if Canchangecolor = Curses_Bool_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Can_Change_Color;
+
+ procedure Color_Content (Color : in Color_Number;
+ Red : out RGB_Value;
+ Green : out RGB_Value;
+ Blue : out RGB_Value)
+ is
+ type C_Short_Access is access all C_Short;
+
+ function Colorcontent (Color : C_Short; R, G, B : C_Short_Access)
+ return C_Int;
+ pragma Import (C, Colorcontent, "color_content");
+
+ R, G, B : aliased C_Short;
+ begin
+ if Colorcontent (C_Short (Color), R'Access, G'Access, B'Access) =
+ Curses_Err then
+ raise Curses_Exception;
+ else
+ Red := RGB_Value (R);
+ Green := RGB_Value (G);
+ Blue := RGB_Value (B);
+ end if;
+ end Color_Content;
+
+------------------------------------------------------------------------------
+ procedure Save_Curses_Mode (Mode : in Curses_Mode)
+ is
+ function Def_Prog_Mode return C_Int;
+ pragma Import (C, Def_Prog_Mode, "def_prog_mode");
+ function Def_Shell_Mode return C_Int;
+ pragma Import (C, Def_Shell_Mode, "def_shell_mode");
+
+ Err : C_Int;
+ begin
+ case Mode is
+ when Curses => Err := Def_Prog_Mode;
+ when Shell => Err := Def_Shell_Mode;
+ end case;
+ if Err = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Save_Curses_Mode;
+
+ procedure Reset_Curses_Mode (Mode : in Curses_Mode)
+ is
+ function Reset_Prog_Mode return C_Int;
+ pragma Import (C, Reset_Prog_Mode, "reset_prog_mode");
+ function Reset_Shell_Mode return C_Int;
+ pragma Import (C, Reset_Shell_Mode, "reset_shell_mode");
+
+ Err : C_Int;
+ begin
+ case Mode is
+ when Curses => Err := Reset_Prog_Mode;
+ when Shell => Err := Reset_Shell_Mode;
+ end case;
+ if Err = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Reset_Curses_Mode;
+
+ procedure Save_Terminal_State
+ is
+ function Savetty return C_Int;
+ pragma Import (C, Savetty, "savetty");
+ begin
+ if Savetty = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Save_Terminal_State;
+
+ procedure Reset_Terminal_State
+ is
+ function Resetty return C_Int;
+ pragma Import (C, Resetty, "resetty");
+ begin
+ if Resetty = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Reset_Terminal_State;
+
+ procedure Rip_Off_Lines (Lines : in Integer;
+ Proc : in Stdscr_Init_Proc)
+ is
+ function Ripoffline (Lines : C_Int;
+ Proc : Stdscr_Init_Proc) return C_Int;
+ pragma Import (C, Ripoffline, "_nc_ripoffline");
+ begin
+ if Ripoffline (C_Int (Lines), Proc) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Rip_Off_Lines;
+
+ procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility)
+ is
+ function Curs_Set (Curs : C_Int) return C_Int;
+ pragma Import (C, Curs_Set, "curs_set");
+
+ Res : C_Int;
+ begin
+ Res := Curs_Set (Cursor_Visibility'Pos (Visibility));
+ if Res /= Curses_Err then
+ Visibility := Cursor_Visibility'Val (Res);
+ end if;
+ end Set_Cursor_Visibility;
+
+ procedure Nap_Milli_Seconds (Ms : in Natural)
+ is
+ function Napms (Ms : C_Int) return C_Int;
+ pragma Import (C, Napms, "napms");
+ begin
+ if Napms (C_Int (Ms)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Nap_Milli_Seconds;
+------------------------------------------------------------------------------
+include(`Public_Variables')
+------------------------------------------------------------------------------
+ procedure Transform_Coordinates
+ (W : in Window := Standard_Window;
+ Line : in out Line_Position;
+ Column : in out Column_Position;
+ Dir : in Transform_Direction := From_Screen)
+ is
+ type Int_Access is access all C_Int;
+ function Transform (W : Window;
+ Y, X : Int_Access;
+ Dir : Curses_Bool) return C_Int;
+ pragma Import (C, Transform, "wmouse_trafo");
+
+ X : aliased C_Int := C_Int (Column);
+ Y : aliased C_Int := C_Int (Line);
+ D : Curses_Bool := Curses_Bool_False;
+ R : C_Int;
+ begin
+ if Dir = To_Screen then
+ D := 1;
+ end if;
+ R := Transform (W, Y'Access, X'Access, D);
+ if R = Curses_False then
+ raise Curses_Exception;
+ else
+ Line := Line_Position (Y);
+ Column := Column_Position (X);
+ end if;
+ end Transform_Coordinates;
+------------------------------------------------------------------------------
+ procedure Use_Default_Colors is
+ function C_Use_Default_Colors return C_Int;
+ pragma Import (C, C_Use_Default_Colors, "use_default_colors");
+ Err : constant C_Int := C_Use_Default_Colors;
+ begin
+ if Err = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Use_Default_Colors;
+
+ procedure Assume_Default_Colors (Fore : Color_Number := Default_Color;
+ Back : Color_Number := Default_Color)
+ is
+ function C_Assume_Default_Colors (Fore : C_Int;
+ Back : C_Int) return C_Int;
+ pragma Import (C, C_Assume_Default_Colors, "assume_default_colors");
+
+ Err : constant C_Int := C_Assume_Default_Colors (C_Int (Fore),
+ C_Int (Back));
+ begin
+ if Err = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Assume_Default_Colors;
+------------------------------------------------------------------------------
+ function Curses_Version return String
+ is
+ function curses_versionC return chars_ptr;
+ pragma Import (C, curses_versionC, "curses_version");
+ Result : constant chars_ptr := curses_versionC;
+ begin
+ return Fill_String (Result);
+ end Curses_Version;
+------------------------------------------------------------------------------
+ procedure Curses_Free_All is
+ procedure curses_freeall;
+ pragma Import (C, curses_freeall, "_nc_freeall");
+ begin
+ -- Use this only for testing: you cannot use curses after calling it,
+ -- so it has to be the "last" thing done before exiting the program.
+ -- This will not really free ALL of memory used by curses. That is
+ -- because it cannot free the memory used for stdout's setbuf. The
+ -- _nc_free_and_exit() procedure can do that, but it can be invoked
+ -- safely only from C - and again, that only as the "last" thing done
+ -- before exiting the program.
+ curses_freeall;
+ end Curses_Free_All;
+------------------------------------------------------------------------------
+ function Use_Extended_Names (Enable : Boolean) return Boolean
+ is
+ function use_extended_namesC (e : Curses_Bool) return C_Int;
+ pragma Import (C, use_extended_namesC, "use_extended_names");
+
+ Res : constant C_Int :=
+ use_extended_namesC (Curses_Bool (Boolean'Pos (Enable)));
+ begin
+ if Res = C_Int (Curses_Bool_False) then
+ return False;
+ else
+ return True;
+ end if;
+ end Use_Extended_Names;
+------------------------------------------------------------------------------
+ procedure Screen_Dump_To_File (Filename : in String)
+ is
+ function scr_dump (f : char_array) return C_Int;
+ pragma Import (C, scr_dump, "scr_dump");
+ Txt : char_array (0 .. Filename'Length);
+ Length : size_t;
+ begin
+ To_C (Filename, Txt, Length);
+ if Curses_Err = scr_dump (Txt) then
+ raise Curses_Exception;
+ end if;
+ end Screen_Dump_To_File;
+
+ procedure Screen_Restore_From_File (Filename : in String)
+ is
+ function scr_restore (f : char_array) return C_Int;
+ pragma Import (C, scr_restore, "scr_restore");
+ Txt : char_array (0 .. Filename'Length);
+ Length : size_t;
+ begin
+ To_C (Filename, Txt, Length);
+ if Curses_Err = scr_restore (Txt) then
+ raise Curses_Exception;
+ end if;
+ end Screen_Restore_From_File;
+
+ procedure Screen_Init_From_File (Filename : in String)
+ is
+ function scr_init (f : char_array) return C_Int;
+ pragma Import (C, scr_init, "scr_init");
+ Txt : char_array (0 .. Filename'Length);
+ Length : size_t;
+ begin
+ To_C (Filename, Txt, Length);
+ if Curses_Err = scr_init (Txt) then
+ raise Curses_Exception;
+ end if;
+ end Screen_Init_From_File;
+
+ procedure Screen_Set_File (Filename : in String)
+ is
+ function scr_set (f : char_array) return C_Int;
+ pragma Import (C, scr_set, "scr_set");
+ Txt : char_array (0 .. Filename'Length);
+ Length : size_t;
+ begin
+ To_C (Filename, Txt, Length);
+ if Curses_Err = scr_set (Txt) then
+ raise Curses_Exception;
+ end if;
+ end Screen_Set_File;
+------------------------------------------------------------------------------
+ procedure Resize (Win : Window := Standard_Window;
+ Number_Of_Lines : Line_Count;
+ Number_Of_Columns : Column_Count) is
+ function wresize (win : Window;
+ lines : C_Int;
+ columns : C_Int) return C_Int;
+ pragma Import (C, wresize);
+ begin
+ if wresize (Win,
+ C_Int (Number_Of_Lines),
+ C_Int (Number_Of_Columns)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Resize;
+------------------------------------------------------------------------------
+
+end Terminal_Interface.Curses;
diff --git a/Ada95/gen/terminal_interface-curses.ads.m4 b/Ada95/gen/terminal_interface-curses.ads.m4
new file mode 100644
index 0000000..4abc55e
--- /dev/null
+++ b/Ada95/gen/terminal_interface-curses.ads.m4
@@ -0,0 +1,1559 @@
+-- -*- ada -*-
+define(`HTMLNAME',`terminal_interface-curses__ads.htm')dnl
+include(M4MACRO)------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2006,2007 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.41 $
+-- $Date: 2007/05/05 20:33:52 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+include(`Base_Defs')
+with System.Storage_Elements;
+with Interfaces.C; -- We need this for some assertions.
+
+package Terminal_Interface.Curses is
+ pragma Preelaborate (Terminal_Interface.Curses);
+include(`Linker_Options')
+include(`Version_Info')
+ type Window is private;
+ Null_Window : constant Window;
+
+ type Line_Position is new Natural; -- line coordinate
+ type Column_Position is new Natural; -- column coordinate
+
+ subtype Line_Count is Line_Position range 1 .. Line_Position'Last;
+ -- Type to count lines. We do not allow null windows, so must be positive
+ subtype Column_Count is Column_Position range 1 .. Column_Position'Last;
+ -- Type to count columns. We do not allow null windows, so must be positive
+
+ type Key_Code is new Integer;
+ -- That is anything including real characters, special keys and logical
+ -- request codes.
+
+ -- FIXME: The "-1" should be Curses_Err
+ subtype Real_Key_Code is Key_Code range -1 .. M4_KEY_MAX;
+ -- This are the codes that potentially represent a real keystroke.
+ -- Not all codes may be possible on a specific terminal. To check the
+ -- availability of a special key, the Has_Key function is provided.
+
+ subtype Special_Key_Code is Real_Key_Code
+ range M4_SPECIAL_FIRST .. Real_Key_Code'Last;
+ -- Type for a function- or special key number
+
+ subtype Normal_Key_Code is Real_Key_Code range
+ Character'Pos (Character'First) .. Character'Pos (Character'Last);
+ -- This are the codes for regular (incl. non-graphical) characters.
+
+ -- Constants for function- and special keys
+ --
+ Key_None : constant Special_Key_Code := M4_SPECIAL_FIRST;
+include(`Key_Definitions')
+ Key_Max : constant Special_Key_Code
+ := Special_Key_Code'Last;
+
+ subtype User_Key_Code is Key_Code
+ range (Key_Max + 129) .. Key_Code'Last;
+ -- This is reserved for user defined key codes. The range between Key_Max
+ -- and the first user code is reserved for subsystems like menu and forms.
+
+ -- For those who like to use the original key names we produce them were
+ -- they differ from the original. Please note that they may differ in
+ -- lower/upper case.
+include(`Old_Keys')dnl
+
+------------------------------------------------------------------------------
+
+ type Color_Number is range -1 .. Integer (Interfaces.C.short'Last);
+ for Color_Number'Size use Interfaces.C.short'Size;
+ -- (n)curses uses a short for the color index
+ -- The model is, that a Color_Number is an index into an array of
+ -- (potentially) definable colors. Some of those indices are
+ -- predefined (see below), although they may not really exist.
+
+include(`Color_Defs')
+ type RGB_Value is range 0 .. Integer (Interfaces.C.short'Last);
+ for RGB_Value'Size use Interfaces.C.short'Size;
+ -- Some system may allow to redefine a color by setting RGB values.
+
+ type Color_Pair is range 0 .. 255;
+ for Color_Pair'Size use 8;
+ subtype Redefinable_Color_Pair is Color_Pair range 1 .. 255;
+ -- (n)curses reserves 1 Byte for the color-pair number. Color Pair 0
+ -- is fixed (Black & White). A color pair is simply a combination of
+ -- two colors described by Color_Numbers, one for the foreground and
+ -- the other for the background
+
+include(`Character_Attribute_Set_Rep')
+ -- (n)curses uses all but the lowest 16 Bits for Attributes.
+
+ Normal_Video : constant Character_Attribute_Set := (others => False);
+
+ type Attributed_Character is
+ record
+ Attr : Character_Attribute_Set;
+ Color : Color_Pair;
+ Ch : Character;
+ end record;
+ pragma Convention (C, Attributed_Character);
+ -- This is the counterpart for the chtype in C.
+
+include(`AC_Rep')
+ Default_Character : constant Attributed_Character
+ := (Ch => Character'First,
+ Color => Color_Pair'First,
+ Attr => (others => False)); -- preelaboratable Normal_Video
+
+ type Attributed_String is array (Positive range <>) of Attributed_Character;
+ pragma Pack (Attributed_String);
+ -- In this binding we allow strings of attributed characters.
+
+ ------------------
+ -- Exceptions --
+ ------------------
+ Curses_Exception : exception;
+ Wrong_Curses_Version : exception;
+
+ -- Those exceptions are raised by the ETI (Extended Terminal Interface)
+ -- subpackets for Menu and Forms handling.
+ --
+ Eti_System_Error : exception;
+ Eti_Bad_Argument : exception;
+ Eti_Posted : exception;
+ Eti_Connected : exception;
+ Eti_Bad_State : exception;
+ Eti_No_Room : exception;
+ Eti_Not_Posted : exception;
+ Eti_Unknown_Command : exception;
+ Eti_No_Match : exception;
+ Eti_Not_Selectable : exception;
+ Eti_Not_Connected : exception;
+ Eti_Request_Denied : exception;
+ Eti_Invalid_Field : exception;
+ Eti_Current : exception;
+
+ --------------------------------------------------------------------------
+ -- External C variables
+ -- Conceptually even in C this are kind of constants, but they are
+ -- initialized and sometimes changed by the library routines at runtime
+ -- depending on the type of terminal. I believe the best way to model
+ -- this is to use functions.
+ --------------------------------------------------------------------------
+
+ function Lines return Line_Count;
+ pragma Inline (Lines);
+
+ function Columns return Column_Count;
+ pragma Inline (Columns);
+
+ function Tab_Size return Natural;
+ pragma Inline (Tab_Size);
+
+ function Number_Of_Colors return Natural;
+ pragma Inline (Number_Of_Colors);
+
+ function Number_Of_Color_Pairs return Natural;
+ pragma Inline (Number_Of_Color_Pairs);
+
+include(`ACS_Map')dnl
+
+ -- MANPAGE(`curs_initscr.3x')
+ -- | Not implemented: newterm, set_term, delscreen
+
+ -- ANCHOR(`stdscr',`Standard_Window')
+ function Standard_Window return Window;
+ -- AKA
+ pragma Inline (Standard_Window);
+
+ -- ANCHOR(`curscr',`Current_Window')
+ function Current_Window return Window;
+ -- AKA
+ pragma Inline (Current_Window);
+
+ -- ANCHOR(`initscr()',`Init_Screen')
+ procedure Init_Screen;
+
+ -- ANCHOR(`initscr()',`Init_Windows')
+ procedure Init_Windows renames Init_Screen;
+ -- AKA
+ pragma Inline (Init_Screen);
+ -- pragma Inline (Init_Windows);
+
+ -- ANCHOR(`endwin()',`End_Windows')
+ procedure End_Windows;
+ -- AKA
+ procedure End_Screen renames End_Windows;
+ pragma Inline (End_Windows);
+ -- pragma Inline (End_Screen);
+
+ -- ANCHOR(`isendwin()',`Is_End_Window')
+ function Is_End_Window return Boolean;
+ -- AKA
+ pragma Inline (Is_End_Window);
+
+ -- MANPAGE(`curs_move.3x')
+
+ -- ANCHOR(`wmove()',`Move_Cursor')
+ procedure Move_Cursor (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position);
+ -- AKA
+ -- ALIAS(`move()')
+ pragma Inline (Move_Cursor);
+
+ -- MANPAGE(`curs_addch.3x')
+
+ -- ANCHOR(`waddch()',`Add')
+ procedure Add (Win : in Window := Standard_Window;
+ Ch : in Attributed_Character);
+ -- AKA
+ -- ALIAS(`addch()')
+
+ procedure Add (Win : in Window := Standard_Window;
+ Ch : in Character);
+ -- Add a single character at the current logical cursor position to
+ -- the window. Use the current windows attributes.
+
+ -- ANCHOR(`mvwaddch()',`Add')
+ procedure Add
+ (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position;
+ Ch : in Attributed_Character);
+ -- AKA
+ -- ALIAS(`mvaddch()')
+
+ procedure Add
+ (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position;
+ Ch : in Character);
+ -- Move to the position and add a single character into the window
+ -- There are more Add routines, so the Inline pragma follows later
+
+ -- ANCHOR(`wechochar()',`Add_With_Immediate_Echo')
+ procedure Add_With_Immediate_Echo
+ (Win : in Window := Standard_Window;
+ Ch : in Attributed_Character);
+ -- AKA
+ -- ALIAS(`echochar()')
+
+ procedure Add_With_Immediate_Echo
+ (Win : in Window := Standard_Window;
+ Ch : in Character);
+ -- Add a character and do an immediate refresh of the screen.
+ pragma Inline (Add_With_Immediate_Echo);
+
+ -- MANPAGE(`curs_window.3x')
+ -- Not Implemented: wcursyncup
+
+ -- ANCHOR(`newwin()',`Create')
+ function Create
+ (Number_Of_Lines : Line_Count;
+ Number_Of_Columns : Column_Count;
+ First_Line_Position : Line_Position;
+ First_Column_Position : Column_Position) return Window;
+ -- Not Implemented: Default Number_Of_Lines, Number_Of_Columns
+ -- the C version lets them be 0, see the man page.
+ -- AKA
+ pragma Inline (Create);
+
+ function New_Window
+ (Number_Of_Lines : Line_Count;
+ Number_Of_Columns : Column_Count;
+ First_Line_Position : Line_Position;
+ First_Column_Position : Column_Position) return Window
+ renames Create;
+ -- pragma Inline (New_Window);
+
+ -- ANCHOR(`delwin()',`Delete')
+ procedure Delete (Win : in out Window);
+ -- AKA
+ -- Reset Win to Null_Window
+ pragma Inline (Delete);
+
+ -- ANCHOR(`subwin()',`Sub_Window')
+ function Sub_Window
+ (Win : Window := Standard_Window;
+ Number_Of_Lines : Line_Count;
+ Number_Of_Columns : Column_Count;
+ First_Line_Position : Line_Position;
+ First_Column_Position : Column_Position) return Window;
+ -- AKA
+ pragma Inline (Sub_Window);
+
+ -- ANCHOR(`derwin()',`Derived_Window')
+ function Derived_Window
+ (Win : Window := Standard_Window;
+ Number_Of_Lines : Line_Count;
+ Number_Of_Columns : Column_Count;
+ First_Line_Position : Line_Position;
+ First_Column_Position : Column_Position) return Window;
+ -- AKA
+ pragma Inline (Derived_Window);
+
+ -- ANCHOR(`dupwin()',`Duplicate')
+ function Duplicate (Win : Window) return Window;
+ -- AKA
+ pragma Inline (Duplicate);
+
+ -- ANCHOR(`mvwin()',`Move_Window')
+ procedure Move_Window (Win : in Window;
+ Line : in Line_Position;
+ Column : in Column_Position);
+ -- AKA
+ pragma Inline (Move_Window);
+
+ -- ANCHOR(`mvderwin()',`Move_Derived_Window')
+ procedure Move_Derived_Window (Win : in Window;
+ Line : in Line_Position;
+ Column : in Column_Position);
+ -- AKA
+ pragma Inline (Move_Derived_Window);
+
+ -- ANCHOR(`wsyncup()',`Synchronize_Upwards')
+ procedure Synchronize_Upwards (Win : in Window);
+ -- AKA
+ pragma Import (C, Synchronize_Upwards, "wsyncup");
+
+ -- ANCHOR(`wsyncdown()',`Synchronize_Downwards')
+ procedure Synchronize_Downwards (Win : in Window);
+ -- AKA
+ pragma Import (C, Synchronize_Downwards, "wsyncdown");
+
+ -- ANCHOR(`syncok()',`Set_Synch_Mode')
+ procedure Set_Synch_Mode (Win : in Window := Standard_Window;
+ Mode : in Boolean := False);
+ -- AKA
+ pragma Inline (Set_Synch_Mode);
+
+ -- MANPAGE(`curs_addstr.3x')
+
+ -- ANCHOR(`waddnstr()',`Add')
+ procedure Add (Win : in Window := Standard_Window;
+ Str : in String;
+ Len : in Integer := -1);
+ -- AKA
+ -- ALIAS(`waddstr()')
+ -- ALIAS(`addnstr()')
+ -- ALIAS(`addstr()')
+
+ -- ANCHOR(`mvwaddnstr()',`Add')
+ procedure Add (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position;
+ Str : in String;
+ Len : in Integer := -1);
+ -- AKA
+ -- ALIAS(`mvwaddstr()')
+ -- ALIAS(`mvaddnstr()')
+ -- ALIAS(`mvaddstr()')
+
+ -- MANPAGE(`curs_addchstr.3x')
+
+ -- ANCHOR(`waddchnstr()',`Add')
+ procedure Add (Win : in Window := Standard_Window;
+ Str : in Attributed_String;
+ Len : in Integer := -1);
+ -- AKA
+ -- ALIAS(`waddchstr()')
+ -- ALIAS(`addchnstr()')
+ -- ALIAS(`addchstr()')
+
+ -- ANCHOR(`mvwaddchnstr()',`Add')
+ procedure Add (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position;
+ Str : in Attributed_String;
+ Len : in Integer := -1);
+ -- AKA
+ -- ALIAS(`mvwaddchstr()')
+ -- ALIAS(`mvaddchnstr()')
+ -- ALIAS(`mvaddchstr()')
+ pragma Inline (Add);
+
+ -- MANPAGE(`curs_border.3x')
+ -- | Not implemented: mvhline, mvwhline, mvvline, mvwvline
+ -- | use Move_Cursor then Horizontal_Line or Vertical_Line
+
+ -- ANCHOR(`wborder()',`Border')
+ procedure Border
+ (Win : in Window := Standard_Window;
+ Left_Side_Symbol : in Attributed_Character := Default_Character;
+ Right_Side_Symbol : in Attributed_Character := Default_Character;
+ Top_Side_Symbol : in Attributed_Character := Default_Character;
+ Bottom_Side_Symbol : in Attributed_Character := Default_Character;
+ Upper_Left_Corner_Symbol : in Attributed_Character := Default_Character;
+ Upper_Right_Corner_Symbol : in Attributed_Character := Default_Character;
+ Lower_Left_Corner_Symbol : in Attributed_Character := Default_Character;
+ Lower_Right_Corner_Symbol : in Attributed_Character := Default_Character
+ );
+ -- AKA
+ -- ALIAS(`border()')
+ pragma Inline (Border);
+
+ -- ANCHOR(`box()',`Box')
+ procedure Box
+ (Win : in Window := Standard_Window;
+ Vertical_Symbol : in Attributed_Character := Default_Character;
+ Horizontal_Symbol : in Attributed_Character := Default_Character);
+ -- AKA
+ pragma Inline (Box);
+
+ -- ANCHOR(`whline()',`Horizontal_Line')
+ procedure Horizontal_Line
+ (Win : in Window := Standard_Window;
+ Line_Size : in Natural;
+ Line_Symbol : in Attributed_Character := Default_Character);
+ -- AKA
+ -- ALIAS(`hline()')
+ pragma Inline (Horizontal_Line);
+
+ -- ANCHOR(`wvline()',`Vertical_Line')
+ procedure Vertical_Line
+ (Win : in Window := Standard_Window;
+ Line_Size : in Natural;
+ Line_Symbol : in Attributed_Character := Default_Character);
+ -- AKA
+ -- ALIAS(`vline()')
+ pragma Inline (Vertical_Line);
+
+ -- MANPAGE(`curs_getch.3x')
+ -- Not implemented: mvgetch, mvwgetch
+
+ -- ANCHOR(`wgetch()',`Get_Keystroke')
+ function Get_Keystroke (Win : Window := Standard_Window)
+ return Real_Key_Code;
+ -- AKA
+ -- ALIAS(`getch()')
+ -- Get a character from the keyboard and echo it - if enabled - to the
+ -- window.
+ -- If for any reason (i.e. a timeout) we couldn't get a character the
+ -- returned keycode is Key_None.
+ pragma Inline (Get_Keystroke);
+
+ -- ANCHOR(`ungetch()',`Undo_Keystroke')
+ procedure Undo_Keystroke (Key : in Real_Key_Code);
+ -- AKA
+ pragma Inline (Undo_Keystroke);
+
+ -- ANCHOR(`has_key()',`Has_Key')
+ function Has_Key (Key : Special_Key_Code) return Boolean;
+ -- AKA
+ pragma Inline (Has_Key);
+
+ -- |
+ -- | Some helper functions
+ -- |
+ function Is_Function_Key (Key : Special_Key_Code) return Boolean;
+ -- Return True if the Key is a function key (i.e. one of F0 .. F63)
+ pragma Inline (Is_Function_Key);
+
+ subtype Function_Key_Number is Integer range 0 .. 63;
+ -- (n)curses allows for 64 function keys.
+
+ function Function_Key (Key : Real_Key_Code) return Function_Key_Number;
+ -- Return the number of the function key. If the code is not a
+ -- function key, a CONSTRAINT_ERROR will be raised.
+ pragma Inline (Function_Key);
+
+ function Function_Key_Code (Key : Function_Key_Number) return Real_Key_Code;
+ -- Return the key code for a given function-key number.
+ pragma Inline (Function_Key_Code);
+
+ -- MANPAGE(`curs_attr.3x')
+ -- | Not implemented attr_off, wattr_off,
+ -- | attr_on, wattr_on, attr_set, wattr_set
+
+ -- PAIR_NUMBER
+ -- PAIR_NUMBER(c) is the same as c.Color
+
+ -- ANCHOR(`standout()',`Standout')
+ procedure Standout (Win : Window := Standard_Window;
+ On : Boolean := True);
+ -- ALIAS(`wstandout()')
+ -- ALIAS(`wstandend()')
+
+ -- ANCHOR(`wattron()',`Switch_Character_Attribute')
+ procedure Switch_Character_Attribute
+ (Win : in Window := Standard_Window;
+ Attr : in Character_Attribute_Set := Normal_Video;
+ On : in Boolean := True); -- if False we switch Off.
+ -- Switches those Attributes set to true in the list.
+ -- AKA
+ -- ALIAS(`wattroff()')
+ -- ALIAS(`attron()')
+ -- ALIAS(`attroff()')
+
+ -- ANCHOR(`wattrset()',`Set_Character_Attributes')
+ procedure Set_Character_Attributes
+ (Win : in Window := Standard_Window;
+ Attr : in Character_Attribute_Set := Normal_Video;
+ Color : in Color_Pair := Color_Pair'First);
+ -- AKA
+ -- ALIAS(`attrset()')
+ pragma Inline (Set_Character_Attributes);
+
+ -- ANCHOR(`wattr_get()',`Get_Character_Attributes')
+ function Get_Character_Attribute
+ (Win : in Window := Standard_Window) return Character_Attribute_Set;
+ -- AKA
+ -- ALIAS(`attr_get()')
+
+ -- ANCHOR(`wattr_get()',`Get_Character_Attribute')
+ function Get_Character_Attribute
+ (Win : in Window := Standard_Window) return Color_Pair;
+ -- AKA
+ pragma Inline (Get_Character_Attribute);
+
+ -- ANCHOR(`wcolor_set()',`Set_Color')
+ procedure Set_Color (Win : in Window := Standard_Window;
+ Pair : in Color_Pair);
+ -- AKA
+ -- ALIAS(`color_set()')
+ pragma Inline (Set_Color);
+
+ -- ANCHOR(`wchgat()',`Change_Attributes')
+ procedure Change_Attributes
+ (Win : in Window := Standard_Window;
+ Count : in Integer := -1;
+ Attr : in Character_Attribute_Set := Normal_Video;
+ Color : in Color_Pair := Color_Pair'First);
+ -- AKA
+ -- ALIAS(`chgat()')
+
+ -- ANCHOR(`mvwchgat()',`Change_Attributes')
+ procedure Change_Attributes
+ (Win : in Window := Standard_Window;
+ Line : in Line_Position := Line_Position'First;
+ Column : in Column_Position := Column_Position'First;
+ Count : in Integer := -1;
+ Attr : in Character_Attribute_Set := Normal_Video;
+ Color : in Color_Pair := Color_Pair'First);
+ -- AKA
+ -- ALIAS(`mvchgat()')
+ pragma Inline (Change_Attributes);
+
+ -- MANPAGE(`curs_beep.3x')
+
+ -- ANCHOR(`beep()',`Beep')
+ procedure Beep;
+ -- AKA
+ pragma Inline (Beep);
+
+ -- ANCHOR(`flash()',`Flash_Screen')
+ procedure Flash_Screen;
+ -- AKA
+ pragma Inline (Flash_Screen);
+
+ -- MANPAGE(`curs_inopts.3x')
+
+ -- | Not implemented : typeahead
+ --
+ -- ANCHOR(`cbreak()',`Set_Cbreak_Mode')
+ procedure Set_Cbreak_Mode (SwitchOn : in Boolean := True);
+ -- AKA
+ -- ALIAS(`nocbreak()')
+ pragma Inline (Set_Cbreak_Mode);
+
+ -- ANCHOR(`raw()',`Set_Raw_Mode')
+ procedure Set_Raw_Mode (SwitchOn : in Boolean := True);
+ -- AKA
+ -- ALIAS(`noraw()')
+ pragma Inline (Set_Raw_Mode);
+
+ -- ANCHOR(`echo()',`Set_Echo_Mode')
+ procedure Set_Echo_Mode (SwitchOn : in Boolean := True);
+ -- AKA
+ -- ALIAS(`noecho()')
+ pragma Inline (Set_Echo_Mode);
+
+ -- ANCHOR(`meta()',`Set_Meta_Mode')
+ procedure Set_Meta_Mode (Win : in Window := Standard_Window;
+ SwitchOn : in Boolean := True);
+ -- AKA
+ pragma Inline (Set_Meta_Mode);
+
+ -- ANCHOR(`keypad()',`Set_KeyPad_Mode')
+ procedure Set_KeyPad_Mode (Win : in Window := Standard_Window;
+ SwitchOn : in Boolean := True);
+ -- AKA
+ pragma Inline (Set_KeyPad_Mode);
+
+ function Get_KeyPad_Mode (Win : in Window := Standard_Window)
+ return Boolean;
+ -- This has no pendant in C. There you've to look into the WINDOWS
+ -- structure to get the value. Bad practice, not repeated in Ada.
+
+ type Half_Delay_Amount is range 1 .. 255;
+
+ -- ANCHOR(`halfdelay()',`Half_Delay')
+ procedure Half_Delay (Amount : in Half_Delay_Amount);
+ -- AKA
+ pragma Inline (Half_Delay);
+
+ -- ANCHOR(`intrflush()',`Set_Flush_On_Interrupt_Mode')
+ procedure Set_Flush_On_Interrupt_Mode
+ (Win : in Window := Standard_Window;
+ Mode : in Boolean := True);
+ -- AKA
+ pragma Inline (Set_Flush_On_Interrupt_Mode);
+
+ -- ANCHOR(`qiflush()',`Set_Queue_Interrupt_Mode')
+ procedure Set_Queue_Interrupt_Mode
+ (Win : in Window := Standard_Window;
+ Flush : in Boolean := True);
+ -- AKA
+ -- ALIAS(`noqiflush()')
+ pragma Inline (Set_Queue_Interrupt_Mode);
+
+ -- ANCHOR(`nodelay()',`Set_NoDelay_Mode')
+ procedure Set_NoDelay_Mode
+ (Win : in Window := Standard_Window;
+ Mode : in Boolean := False);
+ -- AKA
+ pragma Inline (Set_NoDelay_Mode);
+
+ type Timeout_Mode is (Blocking, Non_Blocking, Delayed);
+
+ -- ANCHOR(`wtimeout()',`Set_Timeout_Mode')
+ procedure Set_Timeout_Mode (Win : in Window := Standard_Window;
+ Mode : in Timeout_Mode;
+ Amount : in Natural); -- in Milliseconds
+ -- AKA
+ -- ALIAS(`timeout()')
+ -- Instead of overloading the semantic of the sign of amount, we
+ -- introduce the Timeout_Mode parameter. This should improve
+ -- readability. For Blocking and Non_Blocking, the Amount is not
+ -- evaluated.
+ -- We don't inline this procedure.
+
+ -- ANCHOR(`notimeout()',`Set_Escape_Time_Mode')
+ procedure Set_Escape_Timer_Mode
+ (Win : in Window := Standard_Window;
+ Timer_Off : in Boolean := False);
+ -- AKA
+ pragma Inline (Set_Escape_Timer_Mode);
+
+ -- MANPAGE(`curs_outopts.3x')
+
+ -- ANCHOR(`nl()',`Set_NL_Mode')
+ procedure Set_NL_Mode (SwitchOn : in Boolean := True);
+ -- AKA
+ -- ALIAS(`nonl()')
+ pragma Inline (Set_NL_Mode);
+
+ -- ANCHOR(`clearok()',`Clear_On_Next_Update')
+ procedure Clear_On_Next_Update
+ (Win : in Window := Standard_Window;
+ Do_Clear : in Boolean := True);
+ -- AKA
+ pragma Inline (Clear_On_Next_Update);
+
+ -- ANCHOR(`idlok()',`Use_Insert_Delete_Line')
+ procedure Use_Insert_Delete_Line
+ (Win : in Window := Standard_Window;
+ Do_Idl : in Boolean := True);
+ -- AKA
+ pragma Inline (Use_Insert_Delete_Line);
+
+ -- ANCHOR(`idcok()',`Use_Insert_Delete_Character')
+ procedure Use_Insert_Delete_Character
+ (Win : in Window := Standard_Window;
+ Do_Idc : in Boolean := True);
+ -- AKA
+ pragma Inline (Use_Insert_Delete_Character);
+
+ -- ANCHOR(`leaveok()',`Leave_Cursor_After_Update')
+ procedure Leave_Cursor_After_Update
+ (Win : in Window := Standard_Window;
+ Do_Leave : in Boolean := True);
+ -- AKA
+ pragma Inline (Leave_Cursor_After_Update);
+
+ -- ANCHOR(`immedok()',`Immediate_Update_Mode')
+ procedure Immediate_Update_Mode
+ (Win : in Window := Standard_Window;
+ Mode : in Boolean := False);
+ -- AKA
+ pragma Inline (Immediate_Update_Mode);
+
+ -- ANCHOR(`scrollok()',`Allow_Scrolling')
+ procedure Allow_Scrolling
+ (Win : in Window := Standard_Window;
+ Mode : in Boolean := False);
+ -- AKA
+ pragma Inline (Allow_Scrolling);
+
+ function Scrolling_Allowed (Win : Window := Standard_Window) return Boolean;
+ -- There is no such function in the C interface.
+ pragma Inline (Scrolling_Allowed);
+
+ -- ANCHOR(`wsetscrreg()',`Set_Scroll_Region')
+ procedure Set_Scroll_Region
+ (Win : in Window := Standard_Window;
+ Top_Line : in Line_Position;
+ Bottom_Line : in Line_Position);
+ -- AKA
+ -- ALIAS(`setscrreg()')
+ pragma Inline (Set_Scroll_Region);
+
+ -- MANPAGE(`curs_refresh.3x')
+
+ -- ANCHOR(`doupdate()',`Update_Screen')
+ procedure Update_Screen;
+ -- AKA
+ pragma Inline (Update_Screen);
+
+ -- ANCHOR(`wrefresh()',`Refresh')
+ procedure Refresh (Win : in Window := Standard_Window);
+ -- AKA
+ -- There is an overloaded Refresh for Pads.
+ -- The Inline pragma appears there
+ -- ALIAS(`refresh()')
+
+ -- ANCHOR(`wnoutrefresh()',`Refresh_Without_Update')
+ procedure Refresh_Without_Update
+ (Win : in Window := Standard_Window);
+ -- AKA
+ -- There is an overloaded Refresh_Without_Update for Pads.
+ -- The Inline pragma appears there
+
+ -- ANCHOR(`redrawwin()',`Redraw')
+ procedure Redraw (Win : in Window := Standard_Window);
+ -- AKA
+
+ -- ANCHOR(`wredrawln()',`Redraw')
+ procedure Redraw (Win : in Window := Standard_Window;
+ Begin_Line : in Line_Position;
+ Line_Count : in Positive);
+ -- AKA
+ pragma Inline (Redraw);
+
+ -- MANPAGE(`curs_clear.3x')
+
+ -- ANCHOR(`werase()',`Erase')
+ procedure Erase (Win : in Window := Standard_Window);
+ -- AKA
+ -- ALIAS(`erase()')
+ pragma Inline (Erase);
+
+ -- ANCHOR(`wclear()',`Clear')
+ procedure Clear
+ (Win : in Window := Standard_Window);
+ -- AKA
+ -- ALIAS(`clear()')
+ pragma Inline (Clear);
+
+ -- ANCHOR(`wclrtobot()',`Clear_To_End_Of_Screen')
+ procedure Clear_To_End_Of_Screen
+ (Win : in Window := Standard_Window);
+ -- AKA
+ -- ALIAS(`clrtobot()')
+ pragma Inline (Clear_To_End_Of_Screen);
+
+ -- ANCHOR(`wclrtoeol()',`Clear_To_End_Of_Line')
+ procedure Clear_To_End_Of_Line
+ (Win : in Window := Standard_Window);
+ -- AKA
+ -- ALIAS(`clrtoeol()')
+ pragma Inline (Clear_To_End_Of_Line);
+
+ -- MANPAGE(`curs_bkgd.3x')
+
+ -- ANCHOR(`wbkgdset()',`Set_Background')
+ -- TODO: we could have Set_Background(Window; Character_Attribute_Set)
+ -- because in C it is common to see bkgdset(A_BOLD) or
+ -- bkgdset(COLOR_PAIR(n))
+ procedure Set_Background
+ (Win : in Window := Standard_Window;
+ Ch : in Attributed_Character);
+ -- AKA
+ -- ALIAS(`bkgdset()')
+ pragma Inline (Set_Background);
+
+ -- ANCHOR(`wbkgd()',`Change_Background')
+ procedure Change_Background
+ (Win : in Window := Standard_Window;
+ Ch : in Attributed_Character);
+ -- AKA
+ -- ALIAS(`bkgd()')
+ pragma Inline (Change_Background);
+
+ -- ANCHOR(`wbkgdget()',`Get_Background')
+ -- ? wbkgdget is not listed in curs_bkgd, getbkgd is thpough.
+ function Get_Background (Win : Window := Standard_Window)
+ return Attributed_Character;
+ -- AKA
+ -- ALIAS(`bkgdget()')
+ pragma Inline (Get_Background);
+
+ -- MANPAGE(`curs_touch.3x')
+
+ -- ANCHOR(`untouchwin()',`Untouch')
+ procedure Untouch (Win : in Window := Standard_Window);
+ -- AKA
+ pragma Inline (Untouch);
+
+ -- ANCHOR(`touchwin()',`Touch')
+ procedure Touch (Win : in Window := Standard_Window);
+ -- AKA
+
+ -- ANCHOR(`touchline()',`Touch')
+ procedure Touch (Win : in Window := Standard_Window;
+ Start : in Line_Position;
+ Count : in Positive);
+ -- AKA
+ pragma Inline (Touch);
+
+ -- ANCHOR(`wtouchln()',`Change_Line_Status')
+ procedure Change_Lines_Status (Win : in Window := Standard_Window;
+ Start : in Line_Position;
+ Count : in Positive;
+ State : in Boolean);
+ -- AKA
+ pragma Inline (Change_Lines_Status);
+
+ -- ANCHOR(`is_linetouched()',`Is_Touched')
+ function Is_Touched (Win : Window := Standard_Window;
+ Line : Line_Position) return Boolean;
+ -- AKA
+
+ -- ANCHOR(`is_wintouched()',`Is_Touched')
+ function Is_Touched (Win : Window := Standard_Window) return Boolean;
+ -- AKA
+ pragma Inline (Is_Touched);
+
+ -- MANPAGE(`curs_overlay.3x')
+
+ -- ANCHOR(`copywin()',`Copy')
+ procedure Copy
+ (Source_Window : in Window;
+ Destination_Window : in Window;
+ Source_Top_Row : in Line_Position;
+ Source_Left_Column : in Column_Position;
+ Destination_Top_Row : in Line_Position;
+ Destination_Left_Column : in Column_Position;
+ Destination_Bottom_Row : in Line_Position;
+ Destination_Right_Column : in Column_Position;
+ Non_Destructive_Mode : in Boolean := True);
+ -- AKA
+ pragma Inline (Copy);
+
+ -- ANCHOR(`overwrite()',`Overwrite')
+ procedure Overwrite (Source_Window : in Window;
+ Destination_Window : in Window);
+ -- AKA
+ pragma Inline (Overwrite);
+
+ -- ANCHOR(`overlay()',`Overlay')
+ procedure Overlay (Source_Window : in Window;
+ Destination_Window : in Window);
+ -- AKA
+ pragma Inline (Overlay);
+
+ -- MANPAGE(`curs_deleteln.3x')
+
+ -- ANCHOR(`winsdelln()',`Insert_Delete_Lines')
+ procedure Insert_Delete_Lines
+ (Win : in Window := Standard_Window;
+ Lines : in Integer := 1); -- default is to insert one line above
+ -- AKA
+ -- ALIAS(`insdelln()')
+ pragma Inline (Insert_Delete_Lines);
+
+ -- ANCHOR(`wdeleteln()',`Delete_Line')
+ procedure Delete_Line (Win : in Window := Standard_Window);
+ -- AKA
+ -- ALIAS(`deleteln()')
+ pragma Inline (Delete_Line);
+
+ -- ANCHOR(`winsertln()',`Insert_Line')
+ procedure Insert_Line (Win : in Window := Standard_Window);
+ -- AKA
+ -- ALIAS(`insertln()')
+ pragma Inline (Insert_Line);
+
+ -- MANPAGE(`curs_getyx.3x')
+
+ -- ANCHOR(`getmaxyx()',`Get_Size')
+ procedure Get_Size
+ (Win : in Window := Standard_Window;
+ Number_Of_Lines : out Line_Count;
+ Number_Of_Columns : out Column_Count);
+ -- AKA
+ pragma Inline (Get_Size);
+
+ -- ANCHOR(`getbegyx()',`Get_Window_Position')
+ procedure Get_Window_Position
+ (Win : in Window := Standard_Window;
+ Top_Left_Line : out Line_Position;
+ Top_Left_Column : out Column_Position);
+ -- AKA
+ pragma Inline (Get_Window_Position);
+
+ -- ANCHOR(`getyx()',`Get_Cursor_Position')
+ procedure Get_Cursor_Position
+ (Win : in Window := Standard_Window;
+ Line : out Line_Position;
+ Column : out Column_Position);
+ -- AKA
+ pragma Inline (Get_Cursor_Position);
+
+ -- ANCHOR(`getparyx()',`Get_Origin_Relative_To_Parent')
+ procedure Get_Origin_Relative_To_Parent
+ (Win : in Window;
+ Top_Left_Line : out Line_Position;
+ Top_Left_Column : out Column_Position;
+ Is_Not_A_Subwindow : out Boolean);
+ -- AKA
+ -- Instead of placing -1 in the coordinates as return, we use a boolean
+ -- to return the info that the window has no parent.
+ pragma Inline (Get_Origin_Relative_To_Parent);
+
+ -- MANPAGE(`curs_pad.3x')
+
+ -- ANCHOR(`newpad()',`New_Pad')
+ function New_Pad (Lines : Line_Count;
+ Columns : Column_Count) return Window;
+ -- AKA
+ pragma Inline (New_Pad);
+
+ -- ANCHOR(`subpad()',`Sub_Pad')
+ function Sub_Pad
+ (Pad : Window;
+ Number_Of_Lines : Line_Count;
+ Number_Of_Columns : Column_Count;
+ First_Line_Position : Line_Position;
+ First_Column_Position : Column_Position) return Window;
+ -- AKA
+ pragma Inline (Sub_Pad);
+
+ -- ANCHOR(`prefresh()',`Refresh')
+ procedure Refresh
+ (Pad : in Window;
+ Source_Top_Row : in Line_Position;
+ Source_Left_Column : in Column_Position;
+ Destination_Top_Row : in Line_Position;
+ Destination_Left_Column : in Column_Position;
+ Destination_Bottom_Row : in Line_Position;
+ Destination_Right_Column : in Column_Position);
+ -- AKA
+ pragma Inline (Refresh);
+
+ -- ANCHOR(`pnoutrefresh()',`Refresh_Without_Update')
+ procedure Refresh_Without_Update
+ (Pad : in Window;
+ Source_Top_Row : in Line_Position;
+ Source_Left_Column : in Column_Position;
+ Destination_Top_Row : in Line_Position;
+ Destination_Left_Column : in Column_Position;
+ Destination_Bottom_Row : in Line_Position;
+ Destination_Right_Column : in Column_Position);
+ -- AKA
+ pragma Inline (Refresh_Without_Update);
+
+ -- ANCHOR(`pechochar()',`Add_Character_To_Pad_And_Echo_It')
+ procedure Add_Character_To_Pad_And_Echo_It
+ (Pad : in Window;
+ Ch : in Attributed_Character);
+ -- AKA
+
+ procedure Add_Character_To_Pad_And_Echo_It
+ (Pad : in Window;
+ Ch : in Character);
+ pragma Inline (Add_Character_To_Pad_And_Echo_It);
+
+ -- MANPAGE(`curs_scroll.3x')
+
+ -- ANCHOR(`wscrl()',`Scroll')
+ procedure Scroll (Win : in Window := Standard_Window;
+ Amount : in Integer := 1);
+ -- AKA
+ -- ALIAS(`scroll()')
+ -- ALIAS(`scrl()')
+ pragma Inline (Scroll);
+
+ -- MANPAGE(`curs_delch.3x')
+
+ -- ANCHOR(`wdelch()',`Delete_Character')
+ procedure Delete_Character (Win : in Window := Standard_Window);
+ -- AKA
+ -- ALIAS(`delch()')
+
+ -- ANCHOR(`mvwdelch()',`Delete_Character')
+ procedure Delete_Character
+ (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position);
+ -- AKA
+ -- ALIAS(`mvdelch()')
+ pragma Inline (Delete_Character);
+
+ -- MANPAGE(`curs_inch.3x')
+
+ -- ANCHOR(`winch()',`Peek')
+ function Peek (Win : Window := Standard_Window)
+ return Attributed_Character;
+ -- ALIAS(`inch()')
+ -- AKA
+
+ -- ANCHOR(`mvwinch()',`Peek')
+ function Peek
+ (Win : Window := Standard_Window;
+ Line : Line_Position;
+ Column : Column_Position) return Attributed_Character;
+ -- AKA
+ -- ALIAS(`mvinch()')
+ -- More Peek's follow, pragma Inline appears later.
+
+ -- MANPAGE(`curs_insch.3x')
+
+ -- ANCHOR(`winsch()',`Insert')
+ procedure Insert (Win : in Window := Standard_Window;
+ Ch : in Attributed_Character);
+ -- AKA
+ -- ALIAS(`insch()')
+
+ -- ANCHOR(`mvwinsch()',`Insert')
+ procedure Insert (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position;
+ Ch : in Attributed_Character);
+ -- AKA
+ -- ALIAS(`mvinsch()')
+
+ -- MANPAGE(`curs_insstr.3x')
+
+ -- ANCHOR(`winsnstr()',`Insert')
+ procedure Insert (Win : in Window := Standard_Window;
+ Str : in String;
+ Len : in Integer := -1);
+ -- AKA
+ -- ALIAS(`winsstr()')
+ -- ALIAS(`insnstr()')
+ -- ALIAS(`insstr()')
+
+ -- ANCHOR(`mvwinsnstr()',`Insert')
+ procedure Insert (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position;
+ Str : in String;
+ Len : in Integer := -1);
+ -- AKA
+ -- ALIAS(`mvwinsstr()')
+ -- ALIAS(`mvinsnstr()')
+ -- ALIAS(`mvinsstr()')
+ pragma Inline (Insert);
+
+ -- MANPAGE(`curs_instr.3x')
+
+ -- ANCHOR(`winnstr()',`Peek')
+ procedure Peek (Win : in Window := Standard_Window;
+ Str : out String;
+ Len : in Integer := -1);
+ -- AKA
+ -- ALIAS(`winstr()')
+ -- ALIAS(`innstr()')
+ -- ALIAS(`instr()')
+
+ -- ANCHOR(`mvwinnstr()',`Peek')
+ procedure Peek (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position;
+ Str : out String;
+ Len : in Integer := -1);
+ -- AKA
+ -- ALIAS(`mvwinstr()')
+ -- ALIAS(`mvinnstr()')
+ -- ALIAS(`mvinstr()')
+
+ -- MANPAGE(`curs_inchstr.3x')
+
+ -- ANCHOR(`winchnstr()',`Peek')
+ procedure Peek (Win : in Window := Standard_Window;
+ Str : out Attributed_String;
+ Len : in Integer := -1);
+ -- AKA
+ -- ALIAS(`winchstr()')
+ -- ALIAS(`inchnstr()')
+ -- ALIAS(`inchstr()')
+
+ -- ANCHOR(`mvwinchnstr()',`Peek')
+ procedure Peek (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position;
+ Str : out Attributed_String;
+ Len : in Integer := -1);
+ -- AKA
+ -- ALIAS(`mvwinchstr()')
+ -- ALIAS(`mvinchnstr()')
+ -- ALIAS(`mvinchstr()')
+ -- We don't inline the Peek procedures
+
+ -- MANPAGE(`curs_getstr.3x')
+
+ -- ANCHOR(`wgetnstr()',`Get')
+ procedure Get (Win : in Window := Standard_Window;
+ Str : out String;
+ Len : in Integer := -1);
+ -- AKA
+ -- ALIAS(`wgetstr()')
+ -- ALIAS(`getnstr()')
+ -- ALIAS(`getstr()')
+ -- actually getstr is not supported because that results in buffer
+ -- overflows.
+
+ -- ANCHOR(`mvwgetnstr()',`Get')
+ procedure Get (Win : in Window := Standard_Window;
+ Line : in Line_Position;
+ Column : in Column_Position;
+ Str : out String;
+ Len : in Integer := -1);
+ -- AKA
+ -- ALIAS(`mvwgetstr()')
+ -- ALIAS(`mvgetnstr()')
+ -- ALIAS(`mvgetstr()')
+ -- Get is not inlined
+
+ -- MANPAGE(`curs_slk.3x')
+
+ -- Not Implemented: slk_attr_on, slk_attr_off, slk_attr_set
+
+ type Soft_Label_Key_Format is (Three_Two_Three,
+ Four_Four,
+ PC_Style, -- ncurses specific
+ PC_Style_With_Index); -- "
+ type Label_Number is new Positive range 1 .. 12;
+ type Label_Justification is (Left, Centered, Right);
+
+ -- ANCHOR(`slk_init()',`Init_Soft_Label_Keys')
+ procedure Init_Soft_Label_Keys
+ (Format : in Soft_Label_Key_Format := Three_Two_Three);
+ -- AKA
+ pragma Inline (Init_Soft_Label_Keys);
+
+ -- ANCHOR(`slk_set()',`Set_Soft_Label_Key')
+ procedure Set_Soft_Label_Key (Label : in Label_Number;
+ Text : in String;
+ Fmt : in Label_Justification := Left);
+ -- AKA
+ -- We don't inline this procedure
+
+ -- ANCHOR(`slk_refresh()',`Refresh_Soft_Label_Key')
+ procedure Refresh_Soft_Label_Keys;
+ -- AKA
+ pragma Inline (Refresh_Soft_Label_Keys);
+
+ -- ANCHOR(`slk_noutrefresh()',`Refresh_Soft_Label_Keys_Without_Update')
+ procedure Refresh_Soft_Label_Keys_Without_Update;
+ -- AKA
+ pragma Inline (Refresh_Soft_Label_Keys_Without_Update);
+
+ -- ANCHOR(`slk_label()',`Get_Soft_Label_Key')
+ procedure Get_Soft_Label_Key (Label : in Label_Number;
+ Text : out String);
+ -- AKA
+
+ -- ANCHOR(`slk_label()',`Get_Soft_Label_Key')
+ function Get_Soft_Label_Key (Label : in Label_Number) return String;
+ -- AKA
+ -- Same as function
+ pragma Inline (Get_Soft_Label_Key);
+
+ -- ANCHOR(`slk_clear()',`Clear_Soft_Label_Keys')
+ procedure Clear_Soft_Label_Keys;
+ -- AKA
+ pragma Inline (Clear_Soft_Label_Keys);
+
+ -- ANCHOR(`slk_restore()',`Restore_Soft_Label_Keys')
+ procedure Restore_Soft_Label_Keys;
+ -- AKA
+ pragma Inline (Restore_Soft_Label_Keys);
+
+ -- ANCHOR(`slk_touch()',`Touch_Soft_Label_Keys')
+ procedure Touch_Soft_Label_Keys;
+ -- AKA
+ pragma Inline (Touch_Soft_Label_Keys);
+
+ -- ANCHOR(`slk_attron()',`Switch_Soft_Label_Key_Attributes')
+ procedure Switch_Soft_Label_Key_Attributes
+ (Attr : in Character_Attribute_Set;
+ On : in Boolean := True);
+ -- AKA
+ -- ALIAS(`slk_attroff()')
+ pragma Inline (Switch_Soft_Label_Key_Attributes);
+
+ -- ANCHOR(`slk_attrset()',`Set_Soft_Label_Key_Attributes')
+ procedure Set_Soft_Label_Key_Attributes
+ (Attr : in Character_Attribute_Set := Normal_Video;
+ Color : in Color_Pair := Color_Pair'First);
+ -- AKA
+ pragma Inline (Set_Soft_Label_Key_Attributes);
+
+ -- ANCHOR(`slk_attr()',`Get_Soft_Label_Key_Attributes')
+ function Get_Soft_Label_Key_Attributes return Character_Attribute_Set;
+ -- AKA
+
+ -- ANCHOR(`slk_attr()',`Get_Soft_Label_Key_Attributes')
+ function Get_Soft_Label_Key_Attributes return Color_Pair;
+ -- AKA
+ pragma Inline (Get_Soft_Label_Key_Attributes);
+
+ -- ANCHOR(`slk_color()',`Set_Soft_Label_Key_Color')
+ procedure Set_Soft_Label_Key_Color (Pair : in Color_Pair);
+ -- AKA
+ pragma Inline (Set_Soft_Label_Key_Color);
+
+ -- MANPAGE(`keybound.3x')
+ -- Not Implemented: keybound
+
+ -- MANPAGE(`keyok.3x')
+
+ -- ANCHOR(`keyok()',`Enable_Key')
+ procedure Enable_Key (Key : in Special_Key_Code;
+ Enable : in Boolean := True);
+ -- AKA
+ pragma Inline (Enable_Key);
+
+ -- MANPAGE(`define_key.3x')
+
+ -- ANCHOR(`define_key()',`Define_Key')
+ procedure Define_Key (Definition : in String;
+ Key : in Special_Key_Code);
+ -- AKA
+ pragma Inline (Define_Key);
+
+ -- MANPAGE(`curs_util.3x')
+
+ -- | Not implemented : filter, use_env
+ -- | putwin, getwin are in the child package PutWin
+ --
+
+ -- ANCHOR(`keyname()',`Key_Name')
+ procedure Key_Name (Key : in Real_Key_Code;
+ Name : out String);
+ -- AKA
+ -- The external name for a real keystroke.
+
+ -- ANCHOR(`keyname()',`Key_Name')
+ function Key_Name (Key : in Real_Key_Code) return String;
+ -- AKA
+ -- Same as function
+ -- We don't inline this routine
+
+ -- ANCHOR(`unctrl()',`Un_Control')
+ procedure Un_Control (Ch : in Attributed_Character;
+ Str : out String);
+ -- AKA
+
+ -- ANCHOR(`unctrl()',`Un_Control')
+ function Un_Control (Ch : in Attributed_Character) return String;
+ -- AKA
+ -- Same as function
+ pragma Inline (Un_Control);
+
+ -- ANCHOR(`delay_output()',`Delay_Output')
+ procedure Delay_Output (Msecs : in Natural);
+ -- AKA
+ pragma Inline (Delay_Output);
+
+ -- ANCHOR(`flushinp()',`Flush_Input')
+ procedure Flush_Input;
+ -- AKA
+ pragma Inline (Flush_Input);
+
+ -- MANPAGE(`curs_termattrs.3x')
+
+ -- ANCHOR(`baudrate()',`Baudrate')
+ function Baudrate return Natural;
+ -- AKA
+ pragma Inline (Baudrate);
+
+ -- ANCHOR(`erasechar()',`Erase_Character')
+ function Erase_Character return Character;
+ -- AKA
+ pragma Inline (Erase_Character);
+
+ -- ANCHOR(`killchar()',`Kill_Character')
+ function Kill_Character return Character;
+ -- AKA
+ pragma Inline (Kill_Character);
+
+ -- ANCHOR(`has_ic()',`Has_Insert_Character')
+ function Has_Insert_Character return Boolean;
+ -- AKA
+ pragma Inline (Has_Insert_Character);
+
+ -- ANCHOR(`has_il()',`Has_Insert_Line')
+ function Has_Insert_Line return Boolean;
+ -- AKA
+ pragma Inline (Has_Insert_Line);
+
+ -- ANCHOR(`termattrs()',`Supported_Attributes')
+ function Supported_Attributes return Character_Attribute_Set;
+ -- AKA
+ pragma Inline (Supported_Attributes);
+
+ -- ANCHOR(`longname()',`Long_Name')
+ procedure Long_Name (Name : out String);
+ -- AKA
+
+ -- ANCHOR(`longname()',`Long_Name')
+ function Long_Name return String;
+ -- AKA
+ -- Same as function
+ pragma Inline (Long_Name);
+
+ -- ANCHOR(`termname()',`Terminal_Name')
+ procedure Terminal_Name (Name : out String);
+ -- AKA
+
+ -- ANCHOR(`termname()',`Terminal_Name')
+ function Terminal_Name return String;
+ -- AKA
+ -- Same as function
+ pragma Inline (Terminal_Name);
+
+ -- MANPAGE(`curs_color.3x')
+
+ -- COLOR_PAIR
+ -- COLOR_PAIR(n) in C is the same as
+ -- Attributed_Character(Ch => Nul, Color => n, Attr => Normal_Video)
+ -- In C you often see something like c = c | COLOR_PAIR(n);
+ -- This is equivalent to c.Color := n;
+
+ -- ANCHOR(`start_color()',`Start_Color')
+ procedure Start_Color;
+ -- AKA
+ pragma Import (C, Start_Color, "start_color");
+
+ -- ANCHOR(`init_pair()',`Init_Pair')
+ procedure Init_Pair (Pair : in Redefinable_Color_Pair;
+ Fore : in Color_Number;
+ Back : in Color_Number);
+ -- AKA
+ pragma Inline (Init_Pair);
+
+ -- ANCHOR(`pair_content()',`Pair_Content')
+ procedure Pair_Content (Pair : in Color_Pair;
+ Fore : out Color_Number;
+ Back : out Color_Number);
+ -- AKA
+ pragma Inline (Pair_Content);
+
+ -- ANCHOR(`has_colors()',`Has_Colors')
+ function Has_Colors return Boolean;
+ -- AKA
+ pragma Inline (Has_Colors);
+
+ -- ANCHOR(`init_color()',`Init_Color')
+ procedure Init_Color (Color : in Color_Number;
+ Red : in RGB_Value;
+ Green : in RGB_Value;
+ Blue : in RGB_Value);
+ -- AKA
+ pragma Inline (Init_Color);
+
+ -- ANCHOR(`can_change_color()',`Can_Change_Color')
+ function Can_Change_Color return Boolean;
+ -- AKA
+ pragma Inline (Can_Change_Color);
+
+ -- ANCHOR(`color_content()',`Color_Content')
+ procedure Color_Content (Color : in Color_Number;
+ Red : out RGB_Value;
+ Green : out RGB_Value;
+ Blue : out RGB_Value);
+ -- AKA
+ pragma Inline (Color_Content);
+
+ -- MANPAGE(`curs_kernel.3x')
+ -- | Not implemented: getsyx, setsyx
+ --
+ type Curses_Mode is (Curses, Shell);
+
+ -- ANCHOR(`def_prog_mode()',`Save_Curses_Mode')
+ procedure Save_Curses_Mode (Mode : in Curses_Mode);
+ -- AKA
+ -- ALIAS(`def_shell_mode()')
+ pragma Inline (Save_Curses_Mode);
+
+ -- ANCHOR(`reset_prog_mode()',`Reset_Curses_Mode')
+ procedure Reset_Curses_Mode (Mode : in Curses_Mode);
+ -- AKA
+ -- ALIAS(`reset_shell_mode()')
+ pragma Inline (Reset_Curses_Mode);
+
+ -- ANCHOR(`savetty()',`Save_Terminal_State')
+ procedure Save_Terminal_State;
+ -- AKA
+ pragma Inline (Save_Terminal_State);
+
+ -- ANCHOR(`resetty();',`Reset_Terminal_State')
+ procedure Reset_Terminal_State;
+ -- AKA
+ pragma Inline (Reset_Terminal_State);
+
+ type Stdscr_Init_Proc is access
+ function (Win : Window;
+ Columns : Column_Count) return Integer;
+ pragma Convention (C, Stdscr_Init_Proc);
+ -- N.B.: the return value is actually ignored, but it seems to be
+ -- a good practice to return 0 if you think all went fine
+ -- and -1 otherwise.
+
+ -- ANCHOR(`ripoffline()',`Rip_Off_Lines')
+ procedure Rip_Off_Lines (Lines : in Integer;
+ Proc : in Stdscr_Init_Proc);
+ -- AKA
+ -- N.B.: to be more precise, this uses a ncurses specific enhancement of
+ -- ripoffline(), in which the Lines argument absolute value is the
+ -- number of lines to be ripped of. The official ripoffline() only
+ -- uses the sign of Lines to rip of a single line from bottom or top.
+ pragma Inline (Rip_Off_Lines);
+
+ type Cursor_Visibility is (Invisible, Normal, Very_Visible);
+
+ -- ANCHOR(`curs_set()',`Set_Cursor_Visibility')
+ procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility);
+ -- AKA
+ pragma Inline (Set_Cursor_Visibility);
+
+ -- ANCHOR(`napms()',`Nap_Milli_Seconds')
+ procedure Nap_Milli_Seconds (Ms : in Natural);
+ -- AKA
+ pragma Inline (Nap_Milli_Seconds);
+
+ -- |=====================================================================
+ -- | Some useful helpers.
+ -- |=====================================================================
+ type Transform_Direction is (From_Screen, To_Screen);
+ procedure Transform_Coordinates
+ (W : in Window := Standard_Window;
+ Line : in out Line_Position;
+ Column : in out Column_Position;
+ Dir : in Transform_Direction := From_Screen);
+ -- This procedure transforms screen coordinates into coordinates relative
+ -- to the window and vice versa, depending on the Dir parameter.
+ -- Screen coordinates are the position informations on the physical device.
+ -- An Curses_Exception will be raised if Line and Column are not in the
+ -- Window or if you pass the Null_Window as argument.
+ -- We don't inline this procedure
+
+ -- MANPAGE(`default_colors.3x')
+
+ -- ANCHOR(`use_default_colors()',`Use_Default_Colors')
+ procedure Use_Default_Colors;
+ -- AKA
+ pragma Inline (Use_Default_Colors);
+
+ -- ANCHOR(`assume_default_colors()',`Assume_Default_Colors')
+ procedure Assume_Default_Colors (Fore : Color_Number := Default_Color;
+ Back : Color_Number := Default_Color);
+ -- AKA
+ pragma Inline (Assume_Default_Colors);
+
+ -- MANPAGE(`curs_extend.3x')
+
+ -- ANCHOR(`curses_version()',`Curses_Version')
+ function Curses_Version return String;
+ -- AKA
+
+ -- ANCHOR(`use_extended_names()',`Use_Extended_Names')
+ -- The returnvalue is the previous setting of the flag
+ function Use_Extended_Names (Enable : Boolean) return Boolean;
+ -- AKA
+
+ -- MANPAGE(`curs_trace.3x')
+
+ -- ANCHOR(`_nc_freeall()',`Curses_Free_All')
+ procedure Curses_Free_All;
+ -- AKA
+
+ -- MANPAGE(`curs_scr_dump.3x')
+
+ -- ANCHOR(`scr_dump()',`Screen_Dump_To_File')
+ procedure Screen_Dump_To_File (Filename : in String);
+ -- AKA
+
+ -- ANCHOR(`scr_restore()',`Screen_Restore_From_File')
+ procedure Screen_Restore_From_File (Filename : in String);
+ -- AKA
+
+ -- ANCHOR(`scr_init()',`Screen_Init_From_File')
+ procedure Screen_Init_From_File (Filename : in String);
+ -- AKA
+
+ -- ANCHOR(`scr_set()',`Screen_Set_File')
+ procedure Screen_Set_File (Filename : in String);
+ -- AKA
+
+ -- MANPAGE(`curs_print.3x')
+ -- Not implemented: mcprint
+
+ -- MANPAGE(`curs_printw.3x')
+ -- Not implemented: printw, wprintw, mvprintw, mvwprintw, vwprintw,
+ -- vw_printw
+ -- Please use the Ada style Text_IO child packages for formatted
+ -- printing. It doesn't make a lot of sense to map the printf style
+ -- C functions to Ada.
+
+ -- MANPAGE(`curs_scanw.3x')
+ -- Not implemented: scanw, wscanw, mvscanw, mvwscanw, vwscanw, vw_scanw
+
+ -- MANPAGE(`resizeterm.3x')
+ -- Not Implemented: resizeterm
+
+ -- MANPAGE(`wresize.3x')
+
+ -- ANCHOR(`wresize()',`Resize')
+ procedure Resize (Win : Window := Standard_Window;
+ Number_Of_Lines : Line_Count;
+ Number_Of_Columns : Column_Count);
+ -- AKA
+
+private
+ type Window is new System.Storage_Elements.Integer_Address;
+ Null_Window : constant Window := 0;
+
+ -- The next constants are generated and may be different on your
+ -- architecture.
+ --
+include(`Window_Offsets')dnl
+ Curses_Bool_False : constant Curses_Bool := 0;
+
+end Terminal_Interface.Curses;
diff --git a/Ada95/samples/Makefile.in b/Ada95/samples/Makefile.in
new file mode 100644
index 0000000..5ee78df
--- /dev/null
+++ b/Ada95/samples/Makefile.in
@@ -0,0 +1,154 @@
+##############################################################################
+# Copyright (c) 1998-2004,2005 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.34 2006/12/17 16:45:02 tom Exp $
+#
+.SUFFIXES:
+
+SHELL = /bin/sh
+THIS = Makefile
+
+x = @PROG_EXT@
+
+srcdir = @srcdir@
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+libdir = @libdir@
+includedir = @includedir@
+
+INSTALL = @INSTALL@
+INSTALL_DATA = @INSTALL_DATA@
+
+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@)
+
+REL_VERSION = @cf_cv_rel_version@
+ABI_VERSION = @cf_cv_abi_version@
+LOCAL_LIBDIR = @top_builddir@/lib
+
+LINK = $(CC)
+LDFLAGS = @LDFLAGS@ @LD_MODEL@ @LIBS@
+
+RANLIB = @RANLIB@
+################################################################################
+ada_srcdir=../src
+
+LD_FLAGS = @LD_MODEL@ $(LOCAL_LIBS) @LDFLAGS@ @LIBS@ @LOCAL_LDFLAGS2@ $(LDFLAGS)
+
+ADA = @cf_ada_compiler@
+ADAFLAGS = @ADAFLAGS@ -I$(srcdir)
+
+ADAMAKE = @cf_ada_make@
+ADAMAKEFLAGS = -a -A$(srcdir) -A$(ada_srcdir) -A$(srcdir)/$(ada_srcdir)
+
+ALIB = @cf_ada_package@
+ABASE = $(ALIB)-curses
+
+CARGS =-cargs $(ADAFLAGS)
+LARGS =-largs @TEST_ARG2@ $(LD_FLAGS) -lAdaCurses
+
+PROGS = tour rain ncurses
+
+TOUR_OBJS = tour.o sample.o sample-curses_demo.o sample-explanation.o \
+ sample-form_demo.o sample-function_key_setting.o \
+ sample-header_handler.o sample-helpers.o \
+ sample-keyboard_handler.o sample-manifest.o sample-menu_demo.o \
+ sample-menu_demo-aux.o sample-text_io_demo.o \
+ sample-curses_demo-attributes.o sample-curses_demo-mouse.o \
+ sample-form_demo-aux.o sample-my_field_type.o
+
+RAIN_OBJS = rain.o status.o
+
+NCURSES_OBJS = ncurses.o ncurses2-getch_test.o \
+ ncurses2-acs_and_scroll.o ncurses2-m.o \
+ ncurses2-acs_display.o ncurses2-menu_test.o \
+ ncurses2-attr_test.o ncurses2-overlap_test.o \
+ ncurses2-color_edit.o ncurses2-slk_test.o \
+ ncurses2-color_test.o ncurses2-test_sgr_attributes.o \
+ ncurses2-demo_forms.o ncurses2-trace_set.o \
+ ncurses2-demo_pad.o ncurses2-util.o \
+ ncurses2-demo_panels.o ncurses2.o \
+ ncurses2-flushinp_test.o
+
+
+all :: tour$x rain$x ncurses$x
+ @echo made $@
+
+sources :
+ @echo made $@
+
+libs \
+install \
+install.libs ::
+ @echo made $@
+
+uninstall \
+uninstall.libs ::
+ @echo made $@
+
+ncurses$x :
+ $(ADAMAKE) $(ADAMAKEFLAGS) ncurses $(CARGS) $(LARGS)
+
+tour$x : explain.msg
+ $(ADAMAKE) $(ADAMAKEFLAGS) tour $(CARGS) $(LARGS)
+
+explain.msg: $(srcdir)/explain.txt
+ cp $(srcdir)/explain.txt $@
+
+rain$x :
+ $(ADAMAKE) $(ADAMAKEFLAGS) rain $(CARGS) $(LARGS)
+
+mostlyclean:
+ @echo made $@
+
+clean :: mostlyclean
+ rm -f *.o *.ali b_t*.* *.s $(PROGS) a.out core b_*_test.c *.xr[bs] \
+ explain.msg trace screendump
+
+distclean :: clean
+ rm -f Makefile
+
+realclean :: distclean
+ @echo made $@
diff --git a/Ada95/samples/README b/Ada95/samples/README
new file mode 100644
index 0000000..c4f16ad
--- /dev/null
+++ b/Ada95/samples/README
@@ -0,0 +1,35 @@
+-------------------------------------------------------------------------------
+-- 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. --
+-------------------------------------------------------------------------------
+-- $Id: README,v 1.2 2006/04/22 22:24:12 tom Exp $
+-------------------------------------------------------------------------------
+
+The intention of the demo at this point in time is not to demonstrate all
+the features of (n)curses and its subsystems, but to give some sample
+sources how to use the binding at all.
+
+Ideally in the future we can combine both goals.
diff --git a/Ada95/samples/explain.txt b/Ada95/samples/explain.txt
new file mode 100644
index 0000000..570f617
--- /dev/null
+++ b/Ada95/samples/explain.txt
@@ -0,0 +1,186 @@
+#VERSION
+This is Version 00.90.00 of the demo package.
+#MENUKEYS
+In a menu you can use the following Keys in the whole application:
+
+ - CTRL-X eXit the menu
+ - CTRL-N Go to next item
+ - CTRL-P Go to previous item
+ - CTRL-U Scroll up one line
+ - CTRL-D Scroll down one line
+ - CTRL-F Scroll down one page
+ - PAGE DOWN Scroll down one page
+ - PAGE UP Scroll back one page
+ - CTRL-B Scroll back one page
+ - CTRL-Y Clear pattern
+ - CTRL-H Delete last character from pattern
+ - Backspace Delete last character from pattern
+ - CTRL-A Next pattern match
+ - CTRL-E Previous pattern match
+ - CTRL-T Toggle item in a multi-selection menu
+ - CR or LF Select an item
+ - HOME Key Go to the first item
+ - F3 Quit the menu
+ - Cursor Down Down one item
+ - Cursor Up Up one item
+ - Cursor Left Left one item
+ - Cursor Right Right one item
+ - END Key Go to last item
+#FORMKEYS
+ - CTRL-X eXit the form
+ - CTRL-F Go forward to the next field
+ - CTRL-B Go backward to the previous field
+ - CTRL-L Go to the field left of the current one
+ - CTRL-R Go to the field right of the current one
+ - CTRL-U Go to the field above the current one
+ - CTRL-D Go to the field below the current one
+
+ - CTRL-W Go to the next word in the field
+ - CTRL-T Go to the previous word in the field
+
+ - CTRL-A Go to the beginning of the field
+ - CTRL-E Go to the end of the field
+
+ - CTRL-I Insert a blank character at the current position
+ - CTRL-O Insert a line
+ - CTRL-V Delete a character
+ - CTRL-H Delete previous character
+ - CTRL-Y Delete a line
+ - CTRL-G Delete a word
+ - CTRL-K Clear to end of field
+
+ - CTRL-N Next choice in a choice field (Enumerations etc.)
+ - CTRL-P Previous choice in a choice field.
+#HELP
+#HELPKEYS
+You may scroll with the Cursor Up/Down Keys.
+You may leave the help with the Function Key labelled 'Quit'.
+#INHELP
+You are already in the help system.
+You may leave the help with the Function Key labelled 'Quit'.
+#MAIN
+This is the main menu of the sample program for the ncurses Ada95
+binding. The main intention of the demo is not to demonstate or
+test all the features of ncurses and it's subsystems, but to provide
+to you some sample code how to use the binding with Ada95.
+
+You may select this options:
+
+ * Look at some ncurses core functions
+ * Look at some features of the menu subsystem
+ * Look at some features of the form subsystem
+ * Look at the output of the Ada.Text_IO like functions
+ for ncurses.
+
+#MAINPAD
+You may press at any place in this demo CTRL-C. This will give you a command
+window. You can just type in the Label-String of a function key, then this
+key will be simulated. This should help you to run the application even if
+you run it on a terminal with no or only a few function keys. With CTRL-N
+and CTRL-P you may browse through the possible values in the command window.
+#MENU00
+Here we give you a selection of various menu demonstrations.
+#MENU-PAD00
+This menu itself is a demo for a single valued, 1-column menu with
+descriptions for the items, a marker and a padding character between
+the item name and the description.
+#MENU01
+This is a demo of the some of the menu layout options. One of them
+is the spacing functionality. Just press the Key labelled "Flip" to
+flip between the non-spaced and a spaced version of the menu. Please
+note that this functionality is unique for ncurses and is not found
+in the SVr4 menu implementation.
+
+This is a menu that sometimes doesn't fit into it's window and
+therefore it becomes a scroll menu.
+
+You can also see here very nicely the pattern matching functionality
+of menus. Type for example a 'J' and you will be positioned to the
+next item after the current starting with a 'J'. Any more characters
+you type in make the pattern more specific. With CTRL-A and CTRL-Z
+(for more details press the Key labelled "Keys") you can browse
+through all the items matching the pattern.
+
+You may change the format of the menu. Just press one of the keys
+labelled "4x1", "4x2" or "4x3" to get a menu with that many rows
+and columns.
+
+With the Keys "O-Row" or "O-Col" (they occupy the same label and
+switch on selection) you can change the major order scheme for
+the menu. If "O-Col" is visible, the menu is currently major
+ordered by rows, you can switch to major column order by pressing
+the key. If "O-Row" is visible, it's just the reverse situation.
+This Key is not visible in "4x1" layout mode, because in this case
+the functionality makes no sense.
+
+With the Keys "Multi" or "Singl" (they occupy the same label and
+switch on selection) you can change whether or not the menu allows
+multiple or only single selection.
+
+With the Keys "+Desc" or "-Desc" (they occupy the same label and
+switch on selection) you can change whether or not the descriptions
+for each item should be displayed. Please not that this key is
+not visible in the "4x3" layout mode, because in this case the
+menu wouldn't fit on a typicall 80x24 screen.
+
+With the Keys "Disab" or "Enab" (they occupy the same label and
+switch on selection) you can dis- or enable the selectability of
+the month with 31 days.
+#MENU-PAD01
+You may press "Flip" to see the effect of ncurses unique menu-spacing.
+The Keys "4x1", "4x2" and "4x3" will change the format of the menu.
+Please note that this is a scrolling menu. You may also play with the
+pattern matching functionality or try to change the format of the menu.
+For more details press the Key labelled "Help".
+#FORM00
+This is a demo of the forms package.
+#FORM-PAD00
+Please note that this demo is far from being complete. It really shows
+only a small part of the functionality of the forms package. Let's hope
+the next version will have a richer demo (You wan't to contribute ?).
+#NOTIMPL
+Sorry this functionality of the demo is not implemented at the moment.
+Remember this is a freeware project, so I can use only my very rare
+free time to continue coding. If you would like to contribute, you
+are very welcome !
+#CURSES00
+This is a menu where you can select some different demos of the ncurses
+functionality.
+#CURSES-PAD00
+Please note that this demo is far from being complete. It really shows
+only a small part of the functionality of the curses package. Let's hope
+the next version will have a richer demo (You wan't to contribute ?).
+#MOUSEKEYS
+In this demo you may use this keys:
+
+ - Key labelled "Help" to get a help
+ - Key labelled "Keys" is what you are reading now
+ - Key labelled "Quit" to leave the demo
+
+You may click the mouse buttons at any location at the screen and look
+at the protocol window !
+#MOUSE00
+A rather simple use of a mouse as demo. It's there just to test the
+code and to provide the sample source.
+
+It might be of interest, that the output into the protocol window is
+done by the (n)curses Text_IO subpackages. Especially the output of
+the button and state names is done by Ads's enumeration IO, which
+allows you to print the names of enumeration literals. That's really
+nice.
+#MOUSE-PAD00
+This is a very simple demo of the mouse features of ncurses. It's there
+just to test whether or not the generated code for the binding really
+works on the different architectures (seems so).
+#ATTRIBDEMO
+Again this is a more than simple demo and just here to give you the
+sourcecode.
+#ATTRIBKEYS
+You may press one of the three well known standard keys of this demo.
+#ATTRIB-PAD00
+Again this is a more than simple demo and just here to give you the
+sourcecode. Feel free to contribute more.
+#TEXTIO
+#TEXTIOKEYS
+#TEXTIO-PAD00
+#END
diff --git a/Ada95/samples/ncurses.adb b/Ada95/samples/ncurses.adb
new file mode 100644
index 0000000..19f658d
--- /dev/null
+++ b/Ada95/samples/ncurses.adb
@@ -0,0 +1,47 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with ncurses2.m; use ncurses2.m;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+
+procedure ncurses is
+begin
+ OS_Exit (main);
+end ncurses;
diff --git a/Ada95/samples/ncurses2-acs_and_scroll.adb b/Ada95/samples/ncurses2-acs_and_scroll.adb
new file mode 100644
index 0000000..07b2d91
--- /dev/null
+++ b/Ada95/samples/ncurses2-acs_and_scroll.adb
@@ -0,0 +1,716 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.8 $
+-- $Date: 2008/07/26 18:47:42 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+-- Windows and scrolling tester.
+-- Demonstrate windows
+
+with Ada.Strings.Fixed;
+with Ada.Strings;
+
+with ncurses2.util; use ncurses2.util;
+with ncurses2.genericPuts;
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
+with Terminal_Interface.Curses.PutWin; use Terminal_Interface.Curses.PutWin;
+
+with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
+with Ada.Streams; use Ada.Streams;
+
+procedure ncurses2.acs_and_scroll is
+
+ Macro_Quit : constant Key_Code := Character'Pos ('Q') mod 16#20#;
+ Macro_Escape : constant Key_Code := Character'Pos ('[') mod 16#20#;
+
+ Quit : constant Key_Code := CTRL ('Q');
+ Escape : constant Key_Code := CTRL ('[');
+
+ Botlines : constant Line_Position := 4;
+
+ type pair is record
+ y : Line_Position;
+ x : Column_Position;
+ end record;
+
+ type Frame;
+ type FrameA is access Frame;
+
+ f : File_Type;
+ dumpfile : constant String := "screendump";
+
+ procedure Outerbox (ul, lr : pair; onoff : Boolean);
+ function HaveKeyPad (w : Window) return Boolean;
+ function HaveScroll (w : Window) return Boolean;
+ procedure newwin_legend (curpw : Window);
+ procedure transient (curpw : Window; msg : String);
+ procedure newwin_report (win : Window := Standard_Window);
+ procedure selectcell (uli : Line_Position;
+ ulj : Column_Position;
+ lri : Line_Position;
+ lrj : Column_Position;
+ p : out pair;
+ b : out Boolean);
+ function getwindow return Window;
+ procedure newwin_move (win : Window;
+ dy : Line_Position;
+ dx : Column_Position);
+ function delete_framed (fp : FrameA; showit : Boolean) return FrameA;
+
+ use Ada.Streams.Stream_IO;
+
+ -- A linked list
+ -- I wish there was a standard library linked list. Oh well.
+ type Frame is record
+ next, last : FrameA;
+ do_scroll : Boolean;
+ do_keypad : Boolean;
+ wind : Window;
+ end record;
+
+ current : FrameA;
+
+ c : Key_Code;
+
+ procedure Outerbox (ul, lr : pair; onoff : Boolean) is
+ begin
+ if onoff then
+ -- Note the fix of an obscure bug
+ -- try making a 1x1 box then enlarging it, the is a blank
+ -- upper left corner!
+ Add (Line => ul.y - 1, Column => ul.x - 1,
+ Ch => ACS_Map (ACS_Upper_Left_Corner));
+ Add (Line => ul.y - 1, Column => lr.x + 1,
+ Ch => ACS_Map (ACS_Upper_Right_Corner));
+ Add (Line => lr.y + 1, Column => lr.x + 1,
+ Ch => ACS_Map (ACS_Lower_Right_Corner));
+ Add (Line => lr.y + 1, Column => ul.x - 1,
+ Ch => ACS_Map (ACS_Lower_Left_Corner));
+
+ Move_Cursor (Line => ul.y - 1, Column => ul.x);
+ Horizontal_Line (Line_Symbol => ACS_Map (ACS_Horizontal_Line),
+ Line_Size => Integer (lr.x - ul.x) + 1);
+ Move_Cursor (Line => ul.y, Column => ul.x - 1);
+ Vertical_Line (Line_Symbol => ACS_Map (ACS_Vertical_Line),
+ Line_Size => Integer (lr.y - ul.y) + 1);
+ Move_Cursor (Line => lr.y + 1, Column => ul.x);
+ Horizontal_Line (Line_Symbol => ACS_Map (ACS_Horizontal_Line),
+ Line_Size => Integer (lr.x - ul.x) + 1);
+ Move_Cursor (Line => ul.y, Column => lr.x + 1);
+ Vertical_Line (Line_Symbol => ACS_Map (ACS_Vertical_Line),
+ Line_Size => Integer (lr.y - ul.y) + 1);
+ else
+ Add (Line => ul.y - 1, Column => ul.x - 1, Ch => ' ');
+ Add (Line => ul.y - 1, Column => lr.x + 1, Ch => ' ');
+ Add (Line => lr.y + 1, Column => lr.x + 1, Ch => ' ');
+ Add (Line => lr.y + 1, Column => ul.x - 1, Ch => ' ');
+
+ Move_Cursor (Line => ul.y - 1, Column => ul.x);
+ Horizontal_Line (Line_Symbol => Blank2,
+ Line_Size => Integer (lr.x - ul.x) + 1);
+ Move_Cursor (Line => ul.y, Column => ul.x - 1);
+ Vertical_Line (Line_Symbol => Blank2,
+ Line_Size => Integer (lr.y - ul.y) + 1);
+ Move_Cursor (Line => lr.y + 1, Column => ul.x);
+ Horizontal_Line (Line_Symbol => Blank2,
+ Line_Size => Integer (lr.x - ul.x) + 1);
+ Move_Cursor (Line => ul.y, Column => lr.x + 1);
+ Vertical_Line (Line_Symbol => Blank2,
+ Line_Size => Integer (lr.y - ul.y) + 1);
+ end if;
+ end Outerbox;
+
+ function HaveKeyPad (w : Window) return Boolean is
+ begin
+ return Get_KeyPad_Mode (w);
+ exception
+ when Curses_Exception => return False;
+ end HaveKeyPad;
+
+ function HaveScroll (w : Window) return Boolean is
+ begin
+ return Scrolling_Allowed (w);
+ exception
+ when Curses_Exception => return False;
+ end HaveScroll;
+
+ procedure newwin_legend (curpw : Window) is
+
+ package p is new genericPuts (200);
+ use p;
+ use p.BS;
+
+ type string_a is access String;
+
+ type rrr is record
+ msg : string_a;
+ code : Integer range 0 .. 3;
+ end record;
+
+ legend : constant array (Positive range <>) of rrr :=
+ (
+ (
+ new String'("^C = create window"), 0
+ ),
+ (
+ new String'("^N = next window"), 0
+ ),
+ (
+ new String'("^P = previous window"), 0
+ ),
+ (
+ new String'("^F = scroll forward"), 0
+ ),
+ (
+ new String'("^B = scroll backward"), 0
+ ),
+ (
+ new String'("^K = keypad(%s)"), 1
+ ),
+ (
+ new String'("^S = scrollok(%s)"), 2
+ ),
+ (
+ new String'("^W = save window to file"), 0
+ ),
+ (
+ new String'("^R = restore window"), 0
+ ),
+ (
+ new String'("^X = resize"), 0
+ ),
+ (
+ new String'("^Q%s = exit"), 3
+ )
+ );
+
+ buf : Bounded_String;
+ do_keypad : constant Boolean := HaveKeyPad (curpw);
+ do_scroll : constant Boolean := HaveScroll (curpw);
+
+ pos : Natural;
+
+ mypair : pair;
+
+ use Ada.Strings.Fixed;
+
+ begin
+ Move_Cursor (Line => Lines - 4, Column => 0);
+ for n in legend'Range loop
+ pos := Ada.Strings.Fixed.Index (Source => legend (n).msg.all,
+ Pattern => "%s");
+ -- buf := (others => ' ');
+ buf := To_Bounded_String (legend (n).msg.all);
+ case legend (n).code is
+ when 0 => null;
+ when 1 =>
+ if do_keypad then
+ Replace_Slice (buf, pos, pos + 1, "yes");
+ else
+ Replace_Slice (buf, pos, pos + 1, "no");
+ end if;
+ when 2 =>
+ if do_scroll then
+ Replace_Slice (buf, pos, pos + 1, "yes");
+ else
+ Replace_Slice (buf, pos, pos + 1, "no");
+ end if;
+ when 3 =>
+ if do_keypad then
+ Replace_Slice (buf, pos, pos + 1, "/ESC");
+ else
+ Replace_Slice (buf, pos, pos + 1, "");
+ end if;
+ end case;
+ Get_Cursor_Position (Line => mypair.y, Column => mypair.x);
+ if Columns < mypair.x + 3 + Column_Position (Length (buf)) then
+ Add (Ch => newl);
+ elsif n /= 1 then -- n /= legen'First
+ Add (Str => ", ");
+ end if;
+ myAdd (Str => buf);
+ end loop;
+ Clear_To_End_Of_Line;
+ end newwin_legend;
+
+ procedure transient (curpw : Window; msg : String) is
+ begin
+ newwin_legend (curpw);
+ if msg /= "" then
+ Add (Line => Lines - 1, Column => 0, Str => msg);
+ Refresh;
+ Nap_Milli_Seconds (1000);
+ end if;
+
+ Move_Cursor (Line => Lines - 1, Column => 0);
+
+ if HaveKeyPad (curpw) then
+ Add (Str => "Non-arrow");
+ else
+ Add (Str => "All other");
+ end if;
+ Add (str => " characters are echoed, window should ");
+ if not HaveScroll (curpw) then
+ Add (Str => "not ");
+ end if;
+ Add (str => "scroll");
+
+ Clear_To_End_Of_Line;
+ end transient;
+
+ procedure newwin_report (win : Window := Standard_Window) is
+ y : Line_Position;
+ x : Column_Position;
+ use Int_IO;
+ tmp2a : String (1 .. 2);
+ tmp2b : String (1 .. 2);
+ begin
+ if win /= Standard_Window then
+ transient (win, "");
+ end if;
+ Get_Cursor_Position (win, y, x);
+ Move_Cursor (Line => Lines - 1, Column => Columns - 17);
+ Put (tmp2a, Integer (y));
+ Put (tmp2b, Integer (x));
+ Add (Str => "Y = " & tmp2a & " X = " & tmp2b);
+ if win /= Standard_Window then
+ Refresh;
+ else
+ Move_Cursor (win, y, x);
+ end if;
+ end newwin_report;
+
+ procedure selectcell (uli : Line_Position;
+ ulj : Column_Position;
+ lri : Line_Position;
+ lrj : Column_Position;
+ p : out pair;
+ b : out Boolean) is
+ c : Key_Code;
+ res : pair;
+ i : Line_Position := 0;
+ j : Column_Position := 0;
+ si : constant Line_Position := lri - uli + 1;
+ sj : constant Column_Position := lrj - ulj + 1;
+ begin
+ res.y := uli;
+ res.x := ulj;
+ loop
+ Move_Cursor (Line => uli + i, Column => ulj + j);
+ newwin_report;
+
+ c := Getchar;
+ case c is
+ when
+ Macro_Quit |
+ Macro_Escape =>
+ -- on the same line macro calls interfere due to the # comment
+ -- this is needed because keypad off affects all windows.
+ -- try removing the ESCAPE and see what happens.
+ b := False;
+ return;
+ when KEY_UP =>
+ i := i + si - 1;
+ -- same as i := i - 1 because of Modulus arithetic,
+ -- on Line_Position, which is a Natural
+ -- the C version uses this form too, interestingly.
+ when KEY_DOWN =>
+ i := i + 1;
+ when KEY_LEFT =>
+ j := j + sj - 1;
+ when KEY_RIGHT =>
+ j := j + 1;
+ when Key_Mouse =>
+ declare
+ event : Mouse_Event;
+ y : Line_Position;
+ x : Column_Position;
+ Button : Mouse_Button;
+ State : Button_State;
+
+ begin
+ event := Get_Mouse;
+ Get_Event (Event => event,
+ Y => y,
+ X => x,
+ Button => Button,
+ State => State);
+ if y > uli and x > ulj then
+ i := y - uli;
+ j := x - ulj;
+ -- same as when others =>
+ res.y := uli + i;
+ res.x := ulj + j;
+ p := res;
+ b := True;
+ return;
+ else
+ Beep;
+ end if;
+ end;
+ when others =>
+ res.y := uli + i;
+ res.x := ulj + j;
+ p := res;
+ b := True;
+ return;
+ end case;
+ i := i mod si;
+ j := j mod sj;
+ end loop;
+ end selectcell;
+
+ function getwindow return Window is
+ rwindow : Window;
+ ul, lr : pair;
+ result : Boolean;
+ begin
+ Move_Cursor (Line => 0, Column => 0);
+ Clear_To_End_Of_Line;
+ Add (Str => "Use arrows to move cursor, anything else to mark corner 1");
+ Refresh;
+ selectcell (2, 1, Lines - Botlines - 2, Columns - 2, ul, result);
+ if not result then
+ return Null_Window;
+ end if;
+ Add (Line => ul.y - 1, Column => ul.x - 1,
+ Ch => ACS_Map (ACS_Upper_Left_Corner));
+ Move_Cursor (Line => 0, Column => 0);
+ Clear_To_End_Of_Line;
+ Add (Str => "Use arrows to move cursor, anything else to mark corner 2");
+ Refresh;
+ selectcell (ul.y, ul.x, Lines - Botlines - 2, Columns - 2, lr, result);
+ if not result then
+ return Null_Window;
+ end if;
+
+ rwindow := Sub_Window (Number_Of_Lines => lr.y - ul.y + 1,
+ Number_Of_Columns => lr.x - ul.x + 1,
+ First_Line_Position => ul.y,
+ First_Column_Position => ul.x);
+
+ Outerbox (ul, lr, True);
+ Refresh;
+
+ Refresh (rwindow);
+
+ Move_Cursor (Line => 0, Column => 0);
+ Clear_To_End_Of_Line;
+ return rwindow;
+ end getwindow;
+
+ procedure newwin_move (win : Window;
+ dy : Line_Position;
+ dx : Column_Position) is
+ cur_y, max_y : Line_Position;
+ cur_x, max_x : Column_Position;
+ begin
+ Get_Cursor_Position (win, cur_y, cur_x);
+ Get_Size (win, max_y, max_x);
+ cur_x := Column_Position'Min (Column_Position'Max (cur_x + dx, 0),
+ max_x - 1);
+ cur_y := Line_Position'Min (Line_Position'Max (cur_y + dy, 0),
+ max_y - 1);
+
+ Move_Cursor (win, Line => cur_y, Column => cur_x);
+ end newwin_move;
+
+ function delete_framed (fp : FrameA; showit : Boolean) return FrameA is
+ np : FrameA;
+ begin
+ fp.last.next := fp.next;
+ fp.next.last := fp.last;
+
+ if showit then
+ Erase (fp.wind);
+ Refresh (fp.wind);
+ end if;
+ Delete (fp.wind);
+
+ if fp = fp.next then
+ np := null;
+ else
+ np := fp.next;
+ end if;
+ -- TODO free(fp);
+ return np;
+ end delete_framed;
+
+ Mask : Event_Mask := No_Events;
+ Mask2 : Event_Mask;
+
+ usescr : Window;
+
+begin
+ if Has_Mouse then
+ Register_Reportable_Event (
+ Button => Left,
+ State => Clicked,
+ Mask => Mask);
+ Mask2 := Start_Mouse (Mask);
+ end if;
+ c := CTRL ('C');
+ Set_Raw_Mode (SwitchOn => True);
+ loop
+ transient (Standard_Window, "");
+ case c is
+ when Character'Pos ('c') mod 16#20# => -- Ctrl('c')
+ declare
+ neww : constant FrameA := new Frame'(null, null,
+ False, False,
+ Null_Window);
+ begin
+ neww.wind := getwindow;
+ if neww.wind = Null_Window then
+ exit;
+ -- was goto breakout; ha ha ha
+ else
+
+ if current = null then
+ neww.next := neww;
+ neww.last := neww;
+ else
+ neww.next := current.next;
+ neww.last := current;
+ neww.last.next := neww;
+ neww.next.last := neww;
+ end if;
+ current := neww;
+
+ Set_KeyPad_Mode (current.wind, True);
+ current.do_keypad := HaveKeyPad (current.wind);
+ current.do_scroll := HaveScroll (current.wind);
+ end if;
+ end;
+ when Character'Pos ('N') mod 16#20# => -- Ctrl('N')
+ if current /= null then
+ current := current.next;
+ end if;
+ when Character'Pos ('P') mod 16#20# => -- Ctrl('P')
+ if current /= null then
+ current := current.last;
+ end if;
+ when Character'Pos ('F') mod 16#20# => -- Ctrl('F')
+ if current /= null and then HaveScroll (current.wind) then
+ Scroll (current.wind, 1);
+ end if;
+ when Character'Pos ('B') mod 16#20# => -- Ctrl('B')
+ if current /= null and then HaveScroll (current.wind) then
+ -- The C version of Scroll may return ERR which is ignored
+ -- we need to avoid the exception
+ -- with the 'and HaveScroll(current.wind)'
+ Scroll (current.wind, -1);
+ end if;
+ when Character'Pos ('K') mod 16#20# => -- Ctrl('K')
+ if current /= null then
+ current.do_keypad := not current.do_keypad;
+ Set_KeyPad_Mode (current.wind, current.do_keypad);
+ end if;
+ when Character'Pos ('S') mod 16#20# => -- Ctrl('S')
+ if current /= null then
+ current.do_scroll := not current.do_scroll;
+ Allow_Scrolling (current.wind, current.do_scroll);
+ end if;
+ when Character'Pos ('W') mod 16#20# => -- Ctrl('W')
+ if current /= current.next then
+ Create (f, Name => dumpfile); -- TODO error checking
+ if not Is_Open (f) then
+ raise Curses_Exception;
+ end if;
+ Put_Window (current.wind, f);
+ Close (f);
+ current := delete_framed (current, True);
+ end if;
+ when Character'Pos ('R') mod 16#20# => -- Ctrl('R')
+ declare
+ neww : FrameA := new Frame'(null, null, False, False,
+ Null_Window);
+ begin
+ Open (f, Mode => In_File, Name => dumpfile);
+ neww := new Frame'(null, null, False, False, Null_Window);
+
+ neww.next := current.next;
+ neww.last := current;
+ neww.last.next := neww;
+ neww.next.last := neww;
+
+ neww.wind := Get_Window (f);
+ Close (f);
+
+ Refresh (neww.wind);
+ end;
+ when Character'Pos ('X') mod 16#20# => -- Ctrl('X')
+ if current /= null then
+ declare
+ tmp, ul, lr : pair;
+ mx : Column_Position;
+ my : Line_Position;
+ tmpbool : Boolean;
+ begin
+ Move_Cursor (Line => 0, Column => 0);
+ Clear_To_End_Of_Line;
+ Add (Str => "Use arrows to move cursor, anything else " &
+ "to mark new corner");
+ Refresh;
+
+ Get_Window_Position (current.wind, ul.y, ul.x);
+
+ selectcell (ul.y, ul.x, Lines - Botlines - 2, Columns - 2,
+ tmp, tmpbool);
+ if not tmpbool then
+ -- the C version had a goto. I refuse gotos.
+ Beep;
+ else
+ Get_Size (current.wind, lr.y, lr.x);
+ lr.y := lr.y + ul.y - 1;
+ lr.x := lr.x + ul.x - 1;
+ Outerbox (ul, lr, False);
+ Refresh_Without_Update;
+
+ Get_Size (current.wind, my, mx);
+ if my > tmp.y - ul.y then
+ Get_Cursor_Position (current.wind, lr.y, lr.x);
+ Move_Cursor (current.wind, tmp.y - ul.y + 1, 0);
+ Clear_To_End_Of_Screen (current.wind);
+ Move_Cursor (current.wind, lr.y, lr.x);
+ end if;
+ if mx > tmp.x - ul.x then
+ for i in 0 .. my - 1 loop
+ Move_Cursor (current.wind, i, tmp.x - ul.x + 1);
+ Clear_To_End_Of_Line (current.wind);
+ end loop;
+ end if;
+ Refresh_Without_Update (current.wind);
+
+ lr := tmp;
+ -- The C version passes invalid args to resize
+ -- which returns an ERR. For Ada we avoid the exception.
+ if lr.y /= ul.y and lr.x /= ul.x then
+ Resize (current.wind, lr.y - ul.y + 0,
+ lr.x - ul.x + 0);
+ end if;
+
+ Get_Window_Position (current.wind, ul.y, ul.x);
+ Get_Size (current.wind, lr.y, lr.x);
+ lr.y := lr.y + ul.y - 1;
+ lr.x := lr.x + ul.x - 1;
+ Outerbox (ul, lr, True);
+ Refresh_Without_Update;
+
+ Refresh_Without_Update (current.wind);
+ Move_Cursor (Line => 0, Column => 0);
+ Clear_To_End_Of_Line;
+ Update_Screen;
+ end if;
+ end;
+ end if;
+ when Key_F10 =>
+ declare tmp : pair; tmpbool : Boolean;
+ begin
+ -- undocumented --- use this to test area clears
+ selectcell (0, 0, Lines - 1, Columns - 1, tmp, tmpbool);
+ Clear_To_End_Of_Screen;
+ Refresh;
+ end;
+ when Key_Cursor_Up =>
+ newwin_move (current.wind, -1, 0);
+ when Key_Cursor_Down =>
+ newwin_move (current.wind, 1, 0);
+ when Key_Cursor_Left =>
+ newwin_move (current.wind, 0, -1);
+ when Key_Cursor_Right =>
+ newwin_move (current.wind, 0, 1);
+ when Key_Backspace | Key_Delete_Char =>
+ declare
+ y : Line_Position;
+ x : Column_Position;
+ tmp : Line_Position;
+ begin
+ Get_Cursor_Position (current.wind, y, x);
+ -- x := x - 1;
+ -- I got tricked by the -1 = Max_Natural - 1 result
+ -- y := y - 1;
+ if not (x = 0 and y = 0) then
+ if x = 0 then
+ y := y - 1;
+ Get_Size (current.wind, tmp, x);
+ end if;
+ x := x - 1;
+ Delete_Character (current.wind, y, x);
+ end if;
+ end;
+ when others =>
+ -- TODO c = '\r' ?
+ if current /= null then
+ declare
+ begin
+ Add (current.wind, Ch => Code_To_Char (c));
+ exception
+ when Curses_Exception => null;
+ -- this happens if we are at the
+ -- lower right of a window and add a character.
+ end;
+ else
+ Beep;
+ end if;
+ end case;
+ newwin_report (current.wind);
+ if current /= null then
+ usescr := current.wind;
+ else
+ usescr := Standard_Window;
+ end if;
+ Refresh (usescr);
+ c := Getchar (usescr);
+ exit when c = Quit or (c = Escape and HaveKeyPad (usescr));
+ -- TODO when does c = ERR happen?
+ end loop;
+
+ -- TODO while current /= null loop
+ -- current := delete_framed(current, False);
+ -- end loop;
+
+ Allow_Scrolling (Mode => True);
+
+ End_Mouse (Mask2);
+ Set_Raw_Mode (SwitchOn => True);
+ Erase;
+ End_Windows;
+
+end ncurses2.acs_and_scroll;
diff --git a/Ada95/samples/ncurses2-acs_and_scroll.ads b/Ada95/samples/ncurses2-acs_and_scroll.ads
new file mode 100644
index 0000000..79e4862
--- /dev/null
+++ b/Ada95/samples/ncurses2-acs_and_scroll.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+procedure ncurses2.acs_and_scroll;
diff --git a/Ada95/samples/ncurses2-acs_display.adb b/Ada95/samples/ncurses2-acs_display.adb
new file mode 100644
index 0000000..a71c61d
--- /dev/null
+++ b/Ada95/samples/ncurses2-acs_display.adb
@@ -0,0 +1,235 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.6 $
+-- $Date: 2008/07/26 18:47:34 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with ncurses2.util; use ncurses2.util;
+with ncurses2.genericPuts;
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+
+with Ada.Strings.Unbounded;
+with Ada.Strings.Fixed;
+
+procedure ncurses2.acs_display is
+ use Int_IO;
+
+ procedure show_upper_chars (first : Integer);
+ function show_1_acs (N : Integer;
+ name : String;
+ code : Attributed_Character)
+ return Integer;
+ procedure show_acs_chars;
+
+ procedure show_upper_chars (first : Integer) is
+ C1 : constant Boolean := (first = 128);
+ last : constant Integer := first + 31;
+ package p is new ncurses2.genericPuts (200);
+ use p;
+ use p.BS;
+ use Ada.Strings.Unbounded;
+
+ tmpa : Unbounded_String;
+ tmpb : BS.Bounded_String;
+ begin
+ Erase;
+ Switch_Character_Attribute
+ (Attr => (Bold_Character => True, others => False));
+ Move_Cursor (Line => 0, Column => 20);
+ tmpa := To_Unbounded_String ("Display of ");
+ if C1 then
+ tmpa := tmpa & "C1";
+ else
+ tmpa := tmpa & "GR";
+ end if;
+ tmpa := tmpa & " Character Codes ";
+ myPut (tmpb, first);
+ Append (tmpa, To_String (tmpb));
+ Append (tmpa, " to ");
+ myPut (tmpb, last);
+ Append (tmpa, To_String (tmpb));
+ Add (Str => To_String (tmpa));
+ Switch_Character_Attribute
+ (On => False,
+ Attr => (Bold_Character => True, others => False));
+ Refresh;
+
+ for code in first .. last loop
+ declare
+ row : constant Line_Position
+ := Line_Position (4 + ((code - first) mod 16));
+ col : constant Column_Position
+ := Column_Position (((code - first) / 16) *
+ Integer (Columns) / 2);
+ tmp3 : String (1 .. 3);
+ tmpx : String (1 .. Integer (Columns / 4));
+ reply : Key_Code;
+ begin
+ Put (tmp3, code);
+ myPut (tmpb, code, 16);
+ tmpa := To_Unbounded_String (tmp3 & " (" & To_String (tmpb) & ')');
+
+ Ada.Strings.Fixed.Move (To_String (tmpa), tmpx,
+ Justify => Ada.Strings.Right);
+ Add (Line => row, Column => col,
+ Str => tmpx & ' ' & ':' & ' ');
+ if C1 then
+ Set_NoDelay_Mode (Mode => True);
+ end if;
+ Add_With_Immediate_Echo (Ch => Code_To_Char (Key_Code (code)));
+ -- TODO check this
+ if C1 then
+ reply := Getchar;
+ while reply /= Key_None loop
+ Add (Ch => Code_To_Char (reply));
+ Nap_Milli_Seconds (10);
+ reply := Getchar;
+ end loop;
+ Set_NoDelay_Mode (Mode => False);
+ end if;
+ end;
+ end loop;
+ end show_upper_chars;
+
+ function show_1_acs (N : Integer;
+ name : String;
+ code : Attributed_Character)
+ return Integer is
+ height : constant Integer := 16;
+ row : constant Line_Position := Line_Position (4 + (N mod height));
+ col : constant Column_Position := Column_Position ((N / height) *
+ Integer (Columns) / 2);
+ tmpx : String (1 .. Integer (Columns) / 3);
+ begin
+ Ada.Strings.Fixed.Move (name, tmpx,
+ Justify => Ada.Strings.Right,
+ Drop => Ada.Strings.Left);
+ Add (Line => row, Column => col, Str => tmpx & ' ' & ':' & ' ');
+ -- we need more room than C because our identifiers are longer
+ -- 22 chars actually
+ Add (Ch => code);
+ return N + 1;
+ end show_1_acs;
+
+ procedure show_acs_chars is
+ n : Integer;
+ begin
+ Erase;
+ Switch_Character_Attribute
+ (Attr => (Bold_Character => True, others => False));
+ Add (Line => 0, Column => 20,
+ Str => "Display of the ACS Character Set");
+ Switch_Character_Attribute (On => False,
+ Attr => (Bold_Character => True,
+ others => False));
+ Refresh;
+
+ -- the following is useful to generate the below
+ -- grep '^[ ]*ACS_' ../src/terminal_interface-curses.ads |
+ -- awk '{print "n := show_1_acs(n, \""$1"\", ACS_Map("$1"));"}'
+
+ n := show_1_acs (0, "ACS_Upper_Left_Corner",
+ ACS_Map (ACS_Upper_Left_Corner));
+ n := show_1_acs (n, "ACS_Lower_Left_Corner",
+ ACS_Map (ACS_Lower_Left_Corner));
+ n := show_1_acs (n, "ACS_Upper_Right_Corner",
+ ACS_Map (ACS_Upper_Right_Corner));
+ n := show_1_acs (n, "ACS_Lower_Right_Corner",
+ ACS_Map (ACS_Lower_Right_Corner));
+ n := show_1_acs (n, "ACS_Left_Tee", ACS_Map (ACS_Left_Tee));
+ n := show_1_acs (n, "ACS_Right_Tee", ACS_Map (ACS_Right_Tee));
+ n := show_1_acs (n, "ACS_Bottom_Tee", ACS_Map (ACS_Bottom_Tee));
+ n := show_1_acs (n, "ACS_Top_Tee", ACS_Map (ACS_Top_Tee));
+ n := show_1_acs (n, "ACS_Horizontal_Line",
+ ACS_Map (ACS_Horizontal_Line));
+ n := show_1_acs (n, "ACS_Vertical_Line", ACS_Map (ACS_Vertical_Line));
+ n := show_1_acs (n, "ACS_Plus_Symbol", ACS_Map (ACS_Plus_Symbol));
+ n := show_1_acs (n, "ACS_Scan_Line_1", ACS_Map (ACS_Scan_Line_1));
+ n := show_1_acs (n, "ACS_Scan_Line_9", ACS_Map (ACS_Scan_Line_9));
+ n := show_1_acs (n, "ACS_Diamond", ACS_Map (ACS_Diamond));
+ n := show_1_acs (n, "ACS_Checker_Board", ACS_Map (ACS_Checker_Board));
+ n := show_1_acs (n, "ACS_Degree", ACS_Map (ACS_Degree));
+ n := show_1_acs (n, "ACS_Plus_Minus", ACS_Map (ACS_Plus_Minus));
+ n := show_1_acs (n, "ACS_Bullet", ACS_Map (ACS_Bullet));
+ n := show_1_acs (n, "ACS_Left_Arrow", ACS_Map (ACS_Left_Arrow));
+ n := show_1_acs (n, "ACS_Right_Arrow", ACS_Map (ACS_Right_Arrow));
+ n := show_1_acs (n, "ACS_Down_Arrow", ACS_Map (ACS_Down_Arrow));
+ n := show_1_acs (n, "ACS_Up_Arrow", ACS_Map (ACS_Up_Arrow));
+ n := show_1_acs (n, "ACS_Board_Of_Squares",
+ ACS_Map (ACS_Board_Of_Squares));
+ n := show_1_acs (n, "ACS_Lantern", ACS_Map (ACS_Lantern));
+ n := show_1_acs (n, "ACS_Solid_Block", ACS_Map (ACS_Solid_Block));
+ n := show_1_acs (n, "ACS_Scan_Line_3", ACS_Map (ACS_Scan_Line_3));
+ n := show_1_acs (n, "ACS_Scan_Line_7", ACS_Map (ACS_Scan_Line_7));
+ n := show_1_acs (n, "ACS_Less_Or_Equal", ACS_Map (ACS_Less_Or_Equal));
+ n := show_1_acs (n, "ACS_Greater_Or_Equal",
+ ACS_Map (ACS_Greater_Or_Equal));
+ n := show_1_acs (n, "ACS_PI", ACS_Map (ACS_PI));
+ n := show_1_acs (n, "ACS_Not_Equal", ACS_Map (ACS_Not_Equal));
+ n := show_1_acs (n, "ACS_Sterling", ACS_Map (ACS_Sterling));
+
+ if n = 0 then
+ raise Constraint_Error;
+ end if;
+ end show_acs_chars;
+
+ c1 : Key_Code;
+ c : Character := 'a';
+begin
+ loop
+ case c is
+ when 'a' =>
+ show_acs_chars;
+ when '0' | '1' | '2' | '3' =>
+ show_upper_chars (ctoi (c) * 32 + 128);
+ when others =>
+ null;
+ end case;
+ Add (Line => Lines - 3, Column => 0,
+ Str => "Note: ANSI terminals may not display C1 characters.");
+ Add (Line => Lines - 2, Column => 0,
+ Str => "Select: a=ACS, 0=C1, 1,2,3=GR characters, q=quit");
+ Refresh;
+ c1 := Getchar;
+ c := Code_To_Char (c1);
+ exit when c = 'q' or c = 'x';
+ end loop;
+ Pause;
+ Erase;
+ End_Windows;
+end ncurses2.acs_display;
diff --git a/Ada95/samples/ncurses2-acs_display.ads b/Ada95/samples/ncurses2-acs_display.ads
new file mode 100644
index 0000000..4e616c5
--- /dev/null
+++ b/Ada95/samples/ncurses2-acs_display.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+procedure ncurses2.acs_display;
diff --git a/Ada95/samples/ncurses2-attr_test.adb b/Ada95/samples/ncurses2-attr_test.adb
new file mode 100644
index 0000000..6627104
--- /dev/null
+++ b/Ada95/samples/ncurses2-attr_test.adb
@@ -0,0 +1,362 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-2007,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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.9 $
+-- $Date: 2008/07/26 18:47:26 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with ncurses2.util; use ncurses2.util;
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Terminfo;
+use Terminal_Interface.Curses.Terminfo;
+with Ada.Characters.Handling;
+with Ada.Strings.Fixed;
+
+procedure ncurses2.attr_test is
+
+ function subset (super, sub : Character_Attribute_Set) return Boolean;
+ function intersect (b, a : Character_Attribute_Set) return Boolean;
+ function has_A_COLOR (attr : Attributed_Character) return Boolean;
+ function show_attr (row : Line_Position;
+ skip : Natural;
+ attr : Character_Attribute_Set;
+ name : String;
+ once : Boolean) return Line_Position;
+ procedure attr_getc (skip : in out Integer;
+ fg, bg : in out Color_Number;
+ result : out Boolean);
+
+ function subset (super, sub : Character_Attribute_Set) return Boolean is
+ begin
+ if
+ (super.Stand_Out or not sub.Stand_Out) and
+ (super.Under_Line or not sub.Under_Line) and
+ (super.Reverse_Video or not sub.Reverse_Video) and
+ (super.Blink or not sub.Blink) and
+ (super.Dim_Character or not sub.Dim_Character) and
+ (super.Bold_Character or not sub.Bold_Character) and
+ (super.Alternate_Character_Set or not sub.Alternate_Character_Set) and
+ (super.Invisible_Character or not sub.Invisible_Character) -- and
+-- (super.Protected_Character or not sub.Protected_Character) and
+-- (super.Horizontal or not sub.Horizontal) and
+-- (super.Left or not sub.Left) and
+-- (super.Low or not sub.Low) and
+-- (super.Right or not sub.Right) and
+-- (super.Top or not sub.Top) and
+-- (super.Vertical or not sub.Vertical)
+ then
+ return True;
+ else
+ return False;
+ end if;
+ end subset;
+
+ function intersect (b, a : Character_Attribute_Set) return Boolean is
+ begin
+ if
+ (a.Stand_Out and b.Stand_Out) or
+ (a.Under_Line and b.Under_Line) or
+ (a.Reverse_Video and b.Reverse_Video) or
+ (a.Blink and b.Blink) or
+ (a.Dim_Character and b.Dim_Character) or
+ (a.Bold_Character and b.Bold_Character) or
+ (a.Alternate_Character_Set and b.Alternate_Character_Set) or
+ (a.Invisible_Character and b.Invisible_Character) -- or
+-- (a.Protected_Character and b.Protected_Character) or
+-- (a.Horizontal and b.Horizontal) or
+-- (a.Left and b.Left) or
+-- (a.Low and b.Low) or
+-- (a.Right and b.Right) or
+-- (a.Top and b.Top) or
+-- (a.Vertical and b.Vertical)
+ then
+ return True;
+ else
+ return False;
+ end if;
+ end intersect;
+
+ function has_A_COLOR (attr : Attributed_Character) return Boolean is
+ begin
+ if attr.Color /= Color_Pair (0) then
+ return True;
+ else
+ return False;
+ end if;
+ end has_A_COLOR;
+
+ -- Print some text with attributes.
+ function show_attr (row : Line_Position;
+ skip : Natural;
+ attr : Character_Attribute_Set;
+ name : String;
+ once : Boolean) return Line_Position is
+
+ function make_record (n : Integer) return Character_Attribute_Set;
+ function make_record (n : Integer) return Character_Attribute_Set is
+ -- unsupported means true
+ a : Character_Attribute_Set := (others => False);
+ m : Integer;
+ rest : Integer;
+ begin
+ -- ncv is a bitmap with these fields
+ -- A_STANDOUT,
+ -- A_UNDERLINE,
+ -- A_REVERSE,
+ -- A_BLINK,
+ -- A_DIM,
+ -- A_BOLD,
+ -- A_INVIS,
+ -- A_PROTECT,
+ -- A_ALTCHARSET
+ -- It means no_color_video,
+ -- video attributes that can't be used with colors
+ -- see man terminfo.5
+ m := n mod 2;
+ rest := n / 2;
+ if 1 = m then
+ a.Stand_Out := True;
+ end if;
+ m := rest mod 2;
+ rest := rest / 2;
+ if 1 = m then
+ a.Under_Line := True;
+ end if;
+ m := rest mod 2;
+ rest := rest / 2;
+ if 1 = m then
+ a.Reverse_Video := True;
+ end if;
+ m := rest mod 2;
+ rest := rest / 2;
+ if 1 = m then
+ a.Blink := True;
+ end if;
+ m := rest mod 2;
+ rest := rest / 2;
+ if 1 = m then
+ a.Bold_Character := True;
+ end if;
+ m := rest mod 2;
+ rest := rest / 2;
+ if 1 = m then
+ a.Invisible_Character := True;
+ end if;
+ m := rest mod 2;
+ rest := rest / 2;
+ if 1 = m then
+ a.Protected_Character := True;
+ end if;
+ m := rest mod 2;
+ rest := rest / 2;
+ if 1 = m then
+ a.Alternate_Character_Set := True;
+ end if;
+
+ return a;
+ end make_record;
+
+ ncv : constant Integer := Get_Number ("ncv");
+
+ begin
+ Move_Cursor (Line => row, Column => 8);
+ Add (Str => name & " mode:");
+ Move_Cursor (Line => row, Column => 24);
+ Add (Ch => '|');
+ if skip /= 0 then
+ -- printw("%*s", skip, " ")
+ Add (Str => Ada.Strings.Fixed."*" (skip, ' '));
+ end if;
+ if once then
+ Switch_Character_Attribute (Attr => attr);
+ else
+ Set_Character_Attributes (Attr => attr);
+ end if;
+ Add (Str => "abcde fghij klmno pqrst uvwxy z");
+ if once then
+ Switch_Character_Attribute (Attr => attr, On => False);
+ end if;
+ if skip /= 0 then
+ Add (Str => Ada.Strings.Fixed."*" (skip, ' '));
+ end if;
+ Add (Ch => '|');
+ if attr /= Normal_Video then
+ declare begin
+ if not subset (super => Supported_Attributes, sub => attr) then
+ Add (Str => " (N/A)");
+ elsif ncv > 0 and has_A_COLOR (Get_Background) then
+ declare
+ Color_Supported_Attributes :
+ constant Character_Attribute_Set := make_record (ncv);
+ begin
+ if intersect (Color_Supported_Attributes, attr) then
+ Add (Str => " (NCV) ");
+ end if;
+ end;
+ end if;
+ end;
+ end if;
+ return row + 2;
+ end show_attr;
+
+ procedure attr_getc (skip : in out Integer;
+ fg, bg : in out Color_Number;
+ result : out Boolean) is
+ ch : constant Key_Code := Getchar;
+ nc : constant Color_Number := Color_Number (Number_Of_Colors);
+ begin
+ result := True;
+ if Ada.Characters.Handling.Is_Digit (Character'Val (ch)) then
+ skip := ctoi (Code_To_Char (ch));
+ elsif ch = CTRL ('L') then
+ Touch;
+ Touch (Current_Window);
+ Refresh;
+ elsif Has_Colors then
+ case ch is
+ -- Note the mathematical elegance compared to the C version.
+ when Character'Pos ('f') => fg := (fg + 1) mod nc;
+ when Character'Pos ('F') => fg := (fg - 1) mod nc;
+ when Character'Pos ('b') => bg := (bg + 1) mod nc;
+ when Character'Pos ('B') => bg := (bg - 1) mod nc;
+ when others =>
+ result := False;
+ end case;
+ else
+ result := False;
+ end if;
+ end attr_getc;
+
+ -- pairs could be defined as array ( Color_Number(0) .. colors - 1) of
+ -- array (Color_Number(0).. colors - 1) of Boolean;
+ pairs : array (Color_Pair'Range) of Boolean := (others => False);
+ fg, bg : Color_Number := Black; -- = 0;
+ xmc : constant Integer := Get_Number ("xmc");
+ skip : Integer := xmc;
+ n : Integer;
+
+ use Int_IO;
+
+begin
+ pairs (0) := True;
+
+ if skip < 0 then
+ skip := 0;
+ end if;
+ n := skip;
+
+ loop
+ declare
+ row : Line_Position := 2;
+ normal : Attributed_Character := Blank2;
+ -- ???
+ begin
+ -- row := 2; -- weird, row is set to 0 without this.
+ -- TODO delete the above line, it was a gdb quirk that confused me
+ if Has_Colors then
+ declare pair : constant Color_Pair :=
+ Color_Pair (fg * Color_Number (Number_Of_Colors) + bg);
+ begin
+ -- Go though each color pair. Assume that the number of
+ -- Redefinable_Color_Pairs is 8*8 with predefined Colors 0..7
+ if not pairs (pair) then
+ Init_Pair (pair, fg, bg);
+ pairs (pair) := True;
+ end if;
+ normal.Color := pair;
+ end;
+ end if;
+ Set_Background (Ch => normal);
+ Erase;
+
+ Add (Line => 0, Column => 20,
+ Str => "Character attribute test display");
+
+ row := show_attr (row, n, (Stand_Out => True, others => False),
+ "STANDOUT", True);
+ row := show_attr (row, n, (Reverse_Video => True, others => False),
+ "REVERSE", True);
+ row := show_attr (row, n, (Bold_Character => True, others => False),
+ "BOLD", True);
+ row := show_attr (row, n, (Under_Line => True, others => False),
+ "UNDERLINE", True);
+ row := show_attr (row, n, (Dim_Character => True, others => False),
+ "DIM", True);
+ row := show_attr (row, n, (Blink => True, others => False),
+ "BLINK", True);
+-- row := show_attr (row, n, (Protected_Character => True,
+-- others => False), "PROTECT", True);
+ row := show_attr (row, n, (Invisible_Character => True,
+ others => False), "INVISIBLE", True);
+ row := show_attr (row, n, Normal_Video, "NORMAL", False);
+
+ Move_Cursor (Line => row, Column => 8);
+ if xmc > -1 then
+ Add (Str => "This terminal does have the magic-cookie glitch");
+ else
+ Add (Str => "This terminal does not have the magic-cookie glitch");
+ end if;
+ Move_Cursor (Line => row + 1, Column => 8);
+ Add (Str => "Enter a digit to set gaps on each side of " &
+ "displayed attributes");
+ Move_Cursor (Line => row + 2, Column => 8);
+ Add (Str => "^L = repaint");
+ if Has_Colors then
+ declare tmp1 : String (1 .. 1);
+ begin
+ Add (Str => ". f/F/b/F toggle colors (");
+ Put (tmp1, Integer (fg));
+ Add (Str => tmp1);
+ Add (Ch => '/');
+ Put (tmp1, Integer (bg));
+ Add (Str => tmp1);
+ Add (Ch => ')');
+ end;
+ end if;
+ Refresh;
+ end;
+
+ declare result : Boolean; begin
+ attr_getc (n, fg, bg, result);
+ exit when not result;
+ end;
+ end loop;
+
+ Set_Background (Ch => Blank2);
+ Erase;
+ End_Windows;
+end ncurses2.attr_test;
diff --git a/Ada95/samples/ncurses2-attr_test.ads b/Ada95/samples/ncurses2-attr_test.ads
new file mode 100644
index 0000000..51c5143
--- /dev/null
+++ b/Ada95/samples/ncurses2-attr_test.ads
@@ -0,0 +1,42 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000,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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.2 $
+-- $Date: 2006/06/25 14:24:40 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+procedure ncurses2.attr_test;
diff --git a/Ada95/samples/ncurses2-color_edit.adb b/Ada95/samples/ncurses2-color_edit.adb
new file mode 100644
index 0000000..a6a35de
--- /dev/null
+++ b/Ada95/samples/ncurses2-color_edit.adb
@@ -0,0 +1,259 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-2004,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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.5 $
+-- $Date: 2006/06/25 14:24:40 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with ncurses2.util; use ncurses2.util;
+with ncurses2.genericPuts;
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+
+procedure ncurses2.color_edit is
+ use Int_IO;
+
+ type RGB_Enum is (Redx, Greenx, Bluex);
+
+ procedure change_color (current : Color_Number;
+ field : RGB_Enum;
+ value : RGB_Value;
+ usebase : Boolean);
+
+ procedure change_color (current : Color_Number;
+ field : RGB_Enum;
+ value : RGB_Value;
+ usebase : Boolean) is
+ red, green, blue : RGB_Value;
+ begin
+ if usebase then
+ Color_Content (current, red, green, blue);
+ else
+ red := 0;
+ green := 0;
+ blue := 0;
+ end if;
+
+ case field is
+ when Redx => red := red + value;
+ when Greenx => green := green + value;
+ when Bluex => blue := blue + value;
+ end case;
+
+ declare
+ begin
+ Init_Color (current, red, green, blue);
+ exception
+ when Curses_Exception => Beep;
+ end;
+
+ end change_color;
+
+ package x is new ncurses2.genericPuts (100); use x;
+
+ tmpb : x.BS.Bounded_String;
+
+ tmp4 : String (1 .. 4);
+ tmp6 : String (1 .. 6);
+ tmp8 : String (1 .. 8);
+ -- This would be easier if Ada had a Bounded_String
+ -- defined as a class instead of the inferior generic package,
+ -- then I could define Put, Add, and Get for them. Blech.
+ value : RGB_Value := 0;
+ red, green, blue : RGB_Value;
+ max_colors : constant Natural := Number_Of_Colors;
+ current : Color_Number := 0;
+ field : RGB_Enum := Redx;
+ this_c : Key_Code := 0;
+begin
+ Refresh;
+
+ for i in Color_Number'(0) .. Color_Number (Number_Of_Colors) loop
+ Init_Pair (Color_Pair (i), White, i);
+ end loop;
+
+ Move_Cursor (Line => Lines - 2, Column => 0);
+ Add (Str => "Number: ");
+ myPut (tmpb, Integer (value));
+ myAdd (Str => tmpb);
+
+ loop
+
+ Switch_Character_Attribute (On => False,
+ Attr => (Bold_Character => True,
+ others => False));
+ Add (Line => 0, Column => 20, Str => "Color RGB Value Editing");
+
+ Switch_Character_Attribute (On => False,
+ Attr => (Bold_Character => True,
+ others => False));
+
+ for i in Color_Number'(0) .. Color_Number (Number_Of_Colors) loop
+ Move_Cursor (Line => 2 + Line_Position (i), Column => 0);
+ if current = i then
+ Add (Ch => '>');
+ else
+ Add (Ch => ' ');
+ end if;
+ -- TODO if i <= color_names'Max then
+ Put (tmp8, Integer (i));
+ Set_Character_Attributes (Color => Color_Pair (i));
+ Add (Str => " ");
+ Set_Character_Attributes;
+
+ Refresh;
+
+ Color_Content (i, red, green, blue);
+ Add (Str => " R = ");
+ if current = i and field = Redx then
+ Switch_Character_Attribute (On => True,
+ Attr => (Stand_Out => True,
+ others => False));
+ end if;
+ Put (tmp4, Integer (red));
+ Add (Str => tmp4);
+ if current = i and field = Redx then
+ Set_Character_Attributes;
+ end if;
+ Add (Str => " G = ");
+ if current = i and field = Greenx then
+ Switch_Character_Attribute (On => True,
+ Attr => (Stand_Out => True,
+ others => False));
+ end if;
+ Put (tmp4, Integer (green));
+ Add (Str => tmp4);
+ if current = i and field = Greenx then
+ Set_Character_Attributes;
+ end if;
+ Add (Str => " B = ");
+ if current = i and field = Bluex then
+ Switch_Character_Attribute (On => True,
+ Attr => (Stand_Out => True,
+ others => False));
+ end if;
+ Put (tmp4, Integer (blue));
+ Add (Str => tmp4);
+ if current = i and field = Bluex then
+ Set_Character_Attributes;
+ end if;
+ Set_Character_Attributes;
+ Add (ch => ')');
+ end loop;
+ Add (Line => Line_Position (Number_Of_Colors + 3), Column => 0,
+ Str => "Use up/down to select a color, left/right to change " &
+ "fields.");
+ Add (Line => Line_Position (Number_Of_Colors + 4), Column => 0,
+ Str => "Modify field by typing nnn=, nnn-, or nnn+. ? for help.");
+
+ Move_Cursor (Line => 2 + Line_Position (current), Column => 0);
+
+ this_c := Getchar;
+ if Is_Digit (this_c) then
+ value := 0;
+ end if;
+
+ case this_c is
+ when KEY_UP =>
+ current := (current - 1) mod Color_Number (max_colors);
+ when KEY_DOWN =>
+ current := (current + 1) mod Color_Number (max_colors);
+ when KEY_RIGHT =>
+ field := RGB_Enum'Val ((RGB_Enum'Pos (field) + 1) mod 3);
+ when KEY_LEFT =>
+ field := RGB_Enum'Val ((RGB_Enum'Pos (field) - 1) mod 3);
+ when
+ Character'Pos ('0') |
+ Character'Pos ('1') |
+ Character'Pos ('2') |
+ Character'Pos ('3') |
+ Character'Pos ('4') |
+ Character'Pos ('5') |
+ Character'Pos ('6') |
+ Character'Pos ('7') |
+ Character'Pos ('8') |
+ Character'Pos ('9') =>
+ value := value * 10 + RGB_Value (ctoi (Code_To_Char (this_c)));
+
+ when Character'Pos ('+') =>
+ change_color (current, field, value, True);
+
+ when Character'Pos ('-') =>
+ change_color (current, field, -value, True);
+
+ when Character'Pos ('=') =>
+ change_color (current, field, value, False);
+
+ when Character'Pos ('?') =>
+ Erase;
+ P (" RGB Value Editing Help");
+ P ("");
+ P ("You are in the RGB value editor. Use the arrow keys to " &
+ "select one of");
+ P ("the fields in one of the RGB triples of the current colors;" &
+ " the one");
+ P ("currently selected will be reverse-video highlighted.");
+ P ("");
+ P ("To change a field, enter the digits of the new value; they" &
+ " are echoed");
+ P ("as entered. Finish by typing `='. The change will take" &
+ " effect instantly.");
+ P ("To increment or decrement a value, use the same procedure," &
+ " but finish");
+ P ("with a `+' or `-'.");
+ P ("");
+ P ("To quit, do `x' or 'q'");
+
+ Pause;
+ Erase;
+ when Character'Pos ('q') |
+ Character'Pos ('x') =>
+ null;
+ when others =>
+ Beep;
+ end case;
+ Move_Cursor (Line => Lines - 2, Column => 0);
+ Put (tmp6, Integer (value));
+ Add (Str => "Number: " & tmp6);
+
+ Clear_To_End_Of_Line;
+ exit when this_c = Character'Pos ('x') or
+ this_c = Character'Pos ('q');
+ end loop;
+
+ Erase;
+ End_Windows;
+end ncurses2.color_edit;
diff --git a/Ada95/samples/ncurses2-color_edit.ads b/Ada95/samples/ncurses2-color_edit.ads
new file mode 100644
index 0000000..3e8e392
--- /dev/null
+++ b/Ada95/samples/ncurses2-color_edit.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+procedure ncurses2.color_edit;
diff --git a/Ada95/samples/ncurses2-color_test.adb b/Ada95/samples/ncurses2-color_test.adb
new file mode 100644
index 0000000..c8f6c83
--- /dev/null
+++ b/Ada95/samples/ncurses2-color_test.adb
@@ -0,0 +1,163 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.3 $
+-- $Date: 2008/07/26 18:47:17 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with ncurses2.util; use ncurses2.util;
+
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Ada.Strings.Fixed;
+
+procedure ncurses2.color_test is
+ use Int_IO;
+
+ procedure show_color_name (y, x : Integer; color : Integer);
+
+ color_names : constant array (0 .. 15) of String (1 .. 7) :=
+ (
+ "black ",
+ "red ",
+ "green ",
+ "yellow ",
+ "blue ",
+ "magenta",
+ "cyan ",
+ "white ",
+ "BLACK ",
+ "RED ",
+ "GREEN ",
+ "YELLOW ",
+ "BLUE ",
+ "MAGENTA",
+ "CYAN ",
+ "WHITE "
+ );
+
+ procedure show_color_name (y, x : Integer; color : Integer) is
+ tmp5 : String (1 .. 5);
+ begin
+ if Number_Of_Colors > 8 then
+
+ Put (tmp5, color);
+ Add (Line => Line_Position (y), Column => Column_Position (x),
+ Str => tmp5);
+ else
+ Add (Line => Line_Position (y), Column => Column_Position (x),
+ Str => color_names (color));
+ end if;
+ end show_color_name;
+
+ top, width : Integer;
+ hello : String (1 .. 5);
+ -- tmp3 : String (1 .. 3);
+ -- tmp2 : String (1 .. 2);
+
+begin
+ Refresh;
+ Add (Str => "There are ");
+ -- Put(tmp3, Number_Of_Colors*Number_Of_Colors);
+ Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors *
+ Number_Of_Colors),
+ Ada.Strings.Left));
+ Add (Str => " color pairs");
+ Add (Ch => newl);
+
+ if Number_Of_Colors > 8 then
+ width := 4;
+ else
+ width := 8;
+ end if;
+
+ if Number_Of_Colors > 8 then
+ hello := "Test ";
+ else
+ hello := "Hello";
+ end if;
+
+ for Bright in Boolean loop
+ if Number_Of_Colors > 8 then
+ top := 0;
+ else
+ top := Boolean'Pos (Bright) * (Number_Of_Colors + 3);
+ end if;
+ Clear_To_End_Of_Screen;
+ Move_Cursor (Line => Line_Position (top) + 1, Column => 0);
+ -- Put(tmp2, Number_Of_Colors);
+ Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors),
+ Ada.Strings.Left));
+ Add (Ch => 'x');
+ Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors),
+ Ada.Strings.Left));
+ Add (Str => " matrix of foreground/background colors, bright *");
+ if Bright then
+ Add (Str => "on");
+ else
+ Add (Str => "off");
+ end if;
+ Add (Ch => '*');
+
+ for i in 0 .. Number_Of_Colors - 1 loop
+ show_color_name (top + 2, (i + 1) * width, i);
+ end loop;
+ for i in 0 .. Number_Of_Colors - 1 loop
+ show_color_name (top + 3 + i, 0, i);
+ end loop;
+ for i in 1 .. Number_Of_Color_Pairs - 1 loop
+ Init_Pair (Color_Pair (i), Color_Number (i mod Number_Of_Colors),
+ Color_Number (i / Number_Of_Colors));
+ -- attron((attr_t) COLOR_PAIR(i)) -- Huh?
+ Set_Color (Pair => Color_Pair (i));
+ if Bright then
+ Switch_Character_Attribute (Attr => (Bold_Character => True,
+ others => False));
+ end if;
+ Add (Line => Line_Position (top + 3 + (i / Number_Of_Colors)),
+ Column => Column_Position ((i mod Number_Of_Colors + 1) *
+ width),
+ Str => hello);
+ Set_Character_Attributes;
+ end loop;
+ if Number_Of_Colors > 8 or Bright then
+ Pause;
+ end if;
+ end loop;
+
+ Erase;
+ End_Windows;
+end ncurses2.color_test;
diff --git a/Ada95/samples/ncurses2-color_test.ads b/Ada95/samples/ncurses2-color_test.ads
new file mode 100644
index 0000000..6e66318
--- /dev/null
+++ b/Ada95/samples/ncurses2-color_test.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+procedure ncurses2.color_test;
diff --git a/Ada95/samples/ncurses2-demo_forms.adb b/Ada95/samples/ncurses2-demo_forms.adb
new file mode 100644
index 0000000..7137aa0
--- /dev/null
+++ b/Ada95/samples/ncurses2-demo_forms.adb
@@ -0,0 +1,497 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-2004,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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.5 $
+-- $Date: 2006/06/25 14:24:40 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with ncurses2.util; use ncurses2.util;
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Forms; use Terminal_Interface.Curses.Forms;
+with Terminal_Interface.Curses.Forms.Field_User_Data;
+with Ada.Characters.Handling;
+with Ada.Strings;
+with Ada.Strings.Bounded;
+
+procedure ncurses2.demo_forms is
+ package BS is new Ada.Strings.Bounded.Generic_Bounded_Length (80);
+
+ type myptr is access Integer;
+
+ -- The C version stores a pointer in the userptr and
+ -- converts it into a long integer.
+ -- The correct, but inconvenient way to do it is to use a
+ -- pointer to long and keep the pointer constant.
+ -- It just adds one memory piece to allocate and deallocate (not done here)
+
+ package StringData is new
+ Terminal_Interface.Curses.Forms.Field_User_Data (Integer, myptr);
+
+ function edit_secure (me : Field; c_in : Key_Code) return Key_Code;
+ function form_virtualize (f : Form; w : Window) return Key_Code;
+ function my_form_driver (f : Form; c : Key_Code) return Boolean;
+ function make_label (frow : Line_Position;
+ fcol : Column_Position;
+ label : String) return Field;
+ function make_field (frow : Line_Position;
+ fcol : Column_Position;
+ rows : Line_Count;
+ cols : Column_Count;
+ secure : Boolean) return Field;
+ procedure display_form (f : Form);
+ procedure erase_form (f : Form);
+
+ -- prints '*' instead of characters.
+ -- Not that this keeps a bug from the C version:
+ -- type in the psasword field then move off and back.
+ -- the cursor is at position one, but
+ -- this assumes it as at the end so text gets appended instead
+ -- of overwtitting.
+ function edit_secure (me : Field; c_in : Key_Code) return Key_Code is
+ rows, frow : Line_Position;
+ nrow : Natural;
+ cols, fcol : Column_Position;
+ nbuf : Buffer_Number;
+ c : Key_Code := c_in;
+ c2 : Character;
+
+ use StringData;
+ begin
+ Info (me, rows, cols, frow, fcol, nrow, nbuf);
+ -- TODO if result = Form_Ok and nbuf > 0 then
+ -- C version checked the return value
+ -- of Info, the Ada binding throws an exception I think.
+ if nbuf > 0 then
+ declare
+ temp : BS.Bounded_String;
+ temps : String (1 .. 10);
+ -- TODO Get_Buffer povides no information on the field length?
+ len : myptr;
+ begin
+ Get_Buffer (me, 1, Str => temps);
+ -- strcpy(temp, field_buffer(me, 1));
+ Get_User_Data (me, len);
+ temp := BS.To_Bounded_String (temps (1 .. len.all));
+ if c <= Key_Max then
+ c2 := Code_To_Char (c);
+ if Ada.Characters.Handling.Is_Graphic (c2) then
+ BS.Append (temp, c2);
+ len.all := len.all + 1;
+ Set_Buffer (me, 1, BS.To_String (temp));
+ c := Character'Pos ('*');
+ else
+ c := 0;
+ end if;
+ else
+ case c is
+ when REQ_BEG_FIELD |
+ REQ_CLR_EOF |
+ REQ_CLR_EOL |
+ REQ_DEL_LINE |
+ REQ_DEL_WORD |
+ REQ_DOWN_CHAR |
+ REQ_END_FIELD |
+ REQ_INS_CHAR |
+ REQ_INS_LINE |
+ REQ_LEFT_CHAR |
+ REQ_NEW_LINE |
+ REQ_NEXT_WORD |
+ REQ_PREV_WORD |
+ REQ_RIGHT_CHAR |
+ REQ_UP_CHAR =>
+ c := 0; -- we don't want to do inline editing
+ when REQ_CLR_FIELD =>
+ if len.all /= 0 then
+ temp := BS.To_Bounded_String ("");
+ Set_Buffer (me, 1, BS.To_String (temp));
+ len.all := 0;
+ end if;
+
+ when REQ_DEL_CHAR |
+ REQ_DEL_PREV =>
+ if len.all /= 0 then
+ BS.Delete (temp, BS.Length (temp), BS.Length (temp));
+ Set_Buffer (me, 1, BS.To_String (temp));
+ len.all := len.all - 1;
+ end if;
+ when others => null;
+ end case;
+ end if;
+ end;
+ end if;
+ return c;
+ end edit_secure;
+
+ mode : Key_Code := REQ_INS_MODE;
+
+ function form_virtualize (f : Form; w : Window) return Key_Code is
+ type lookup_t is record
+ code : Key_Code;
+ result : Key_Code;
+ -- should be Form_Request_Code, but we need MAX_COMMAND + 1
+ end record;
+
+ lookup : constant array (Positive range <>) of lookup_t :=
+ (
+ (
+ Character'Pos ('A') mod 16#20#, REQ_NEXT_CHOICE
+ ),
+ (
+ Character'Pos ('B') mod 16#20#, REQ_PREV_WORD
+ ),
+ (
+ Character'Pos ('C') mod 16#20#, REQ_CLR_EOL
+ ),
+ (
+ Character'Pos ('D') mod 16#20#, REQ_DOWN_FIELD
+ ),
+ (
+ Character'Pos ('E') mod 16#20#, REQ_END_FIELD
+ ),
+ (
+ Character'Pos ('F') mod 16#20#, REQ_NEXT_PAGE
+ ),
+ (
+ Character'Pos ('G') mod 16#20#, REQ_DEL_WORD
+ ),
+ (
+ Character'Pos ('H') mod 16#20#, REQ_DEL_PREV
+ ),
+ (
+ Character'Pos ('I') mod 16#20#, REQ_INS_CHAR
+ ),
+ (
+ Character'Pos ('K') mod 16#20#, REQ_CLR_EOF
+ ),
+ (
+ Character'Pos ('L') mod 16#20#, REQ_LEFT_FIELD
+ ),
+ (
+ Character'Pos ('M') mod 16#20#, REQ_NEW_LINE
+ ),
+ (
+ Character'Pos ('N') mod 16#20#, REQ_NEXT_FIELD
+ ),
+ (
+ Character'Pos ('O') mod 16#20#, REQ_INS_LINE
+ ),
+ (
+ Character'Pos ('P') mod 16#20#, REQ_PREV_FIELD
+ ),
+ (
+ Character'Pos ('R') mod 16#20#, REQ_RIGHT_FIELD
+ ),
+ (
+ Character'Pos ('S') mod 16#20#, REQ_BEG_FIELD
+ ),
+ (
+ Character'Pos ('U') mod 16#20#, REQ_UP_FIELD
+ ),
+ (
+ Character'Pos ('V') mod 16#20#, REQ_DEL_CHAR
+ ),
+ (
+ Character'Pos ('W') mod 16#20#, REQ_NEXT_WORD
+ ),
+ (
+ Character'Pos ('X') mod 16#20#, REQ_CLR_FIELD
+ ),
+ (
+ Character'Pos ('Y') mod 16#20#, REQ_DEL_LINE
+ ),
+ (
+ Character'Pos ('Z') mod 16#20#, REQ_PREV_CHOICE
+ ),
+ (
+ Character'Pos ('[') mod 16#20#, -- ESCAPE
+ Form_Request_Code'Last + 1
+ ),
+ (
+ Key_Backspace, REQ_DEL_PREV
+ ),
+ (
+ KEY_DOWN, REQ_DOWN_CHAR
+ ),
+ (
+ Key_End, REQ_LAST_FIELD
+ ),
+ (
+ Key_Home, REQ_FIRST_FIELD
+ ),
+ (
+ KEY_LEFT, REQ_LEFT_CHAR
+ ),
+ (
+ KEY_LL, REQ_LAST_FIELD
+ ),
+ (
+ Key_Next, REQ_NEXT_FIELD
+ ),
+ (
+ KEY_NPAGE, REQ_NEXT_PAGE
+ ),
+ (
+ KEY_PPAGE, REQ_PREV_PAGE
+ ),
+ (
+ Key_Previous, REQ_PREV_FIELD
+ ),
+ (
+ KEY_RIGHT, REQ_RIGHT_CHAR
+ ),
+ (
+ KEY_UP, REQ_UP_CHAR
+ ),
+ (
+ Character'Pos ('Q') mod 16#20#, -- QUIT
+ Form_Request_Code'Last + 1 -- TODO MAX_FORM_COMMAND + 1
+ )
+ );
+
+ c : Key_Code := Getchar (w);
+ me : constant Field := Current (f);
+
+ begin
+ if c = Character'Pos (']') mod 16#20# then
+ if mode = REQ_INS_MODE then
+ mode := REQ_OVL_MODE;
+ else
+ mode := REQ_INS_MODE;
+ end if;
+ c := mode;
+ else
+ for n in lookup'Range loop
+ if lookup (n).code = c then
+ c := lookup (n).result;
+ exit;
+ end if;
+ end loop;
+ end if;
+
+ -- Force the field that the user is typing into to be in reverse video,
+ -- while the other fields are shown underlined.
+ if c <= Key_Max then
+ c := edit_secure (me, c);
+ Set_Background (me, (Reverse_Video => True, others => False));
+ elsif c <= Form_Request_Code'Last then
+ c := edit_secure (me, c);
+ Set_Background (me, (Under_Line => True, others => False));
+ end if;
+ return c;
+ end form_virtualize;
+
+ function my_form_driver (f : Form; c : Key_Code) return Boolean is
+ flag : constant Driver_Result := Driver (f, F_Validate_Field);
+ begin
+ if c = Form_Request_Code'Last + 1
+ and flag = Form_Ok then
+ return True;
+ else
+ Beep;
+ return False;
+ end if;
+ end my_form_driver;
+
+ function make_label (frow : Line_Position;
+ fcol : Column_Position;
+ label : String) return Field is
+ f : constant Field := Create (1, label'Length, frow, fcol, 0, 0);
+ o : Field_Option_Set := Get_Options (f);
+ begin
+ if f /= Null_Field then
+ Set_Buffer (f, 0, label);
+ o.Active := False;
+ Set_Options (f, o);
+ end if;
+ return f;
+ end make_label;
+
+ function make_field (frow : Line_Position;
+ fcol : Column_Position;
+ rows : Line_Count;
+ cols : Column_Count;
+ secure : Boolean) return Field is
+ f : Field;
+ use StringData;
+ len : myptr;
+ begin
+ if secure then
+ f := Create (rows, cols, frow, fcol, 0, 1);
+ else
+ f := Create (rows, cols, frow, fcol, 0, 0);
+ end if;
+
+ if f /= Null_Field then
+ Set_Background (f, (Under_Line => True, others => False));
+ len := new Integer;
+ len.all := 0;
+ Set_User_Data (f, len);
+ end if;
+ return f;
+ end make_field;
+
+ procedure display_form (f : Form) is
+ w : Window;
+ rows : Line_Count;
+ cols : Column_Count;
+ begin
+ Scale (f, rows, cols);
+
+ w := New_Window (rows + 2, cols + 4, 0, 0);
+ if w /= Null_Window then
+ Set_Window (f, w);
+ Set_Sub_Window (f, Derived_Window (w, rows, cols, 1, 2));
+ Box (w); -- 0,0
+ Set_KeyPad_Mode (w, True);
+ end if;
+
+ -- TODO if Post(f) /= Form_Ok then it's a procedure
+ declare
+ begin
+ Post (f);
+ exception
+ when
+ Eti_System_Error |
+ Eti_Bad_Argument |
+ Eti_Posted |
+ Eti_Connected |
+ Eti_Bad_State |
+ Eti_No_Room |
+ Eti_Not_Posted |
+ Eti_Unknown_Command |
+ Eti_No_Match |
+ Eti_Not_Selectable |
+ Eti_Not_Connected |
+ Eti_Request_Denied |
+ Eti_Invalid_Field |
+ Eti_Current =>
+ Refresh (w);
+ end;
+ -- end if;
+ end display_form;
+
+ procedure erase_form (f : Form) is
+ w : Window := Get_Window (f);
+ s : Window := Get_Sub_Window (f);
+ begin
+ Post (f, False);
+ Erase (w);
+ Refresh (w);
+ Delete (s);
+ Delete (w);
+ end erase_form;
+
+ finished : Boolean := False;
+ f : constant Field_Array_Access := new Field_Array (1 .. 12);
+ secure : Field;
+ myform : Form;
+ w : Window;
+ c : Key_Code;
+ result : Driver_Result;
+begin
+ Move_Cursor (Line => 18, Column => 0);
+ Add (Str => "Defined form-traversal keys: ^Q/ESC- exit form");
+ Add (Ch => newl);
+ Add (Str => "^N -- go to next field ^P -- go to previous field");
+ Add (Ch => newl);
+ Add (Str => "Home -- go to first field End -- go to last field");
+ Add (Ch => newl);
+ Add (Str => "^L -- go to field to left ^R -- go to field to right");
+ Add (Ch => newl);
+ Add (Str => "^U -- move upward to field ^D -- move downward to field");
+ Add (Ch => newl);
+ Add (Str => "^W -- go to next word ^B -- go to previous word");
+ Add (Ch => newl);
+ Add (Str => "^S -- go to start of field ^E -- go to end of field");
+ Add (Ch => newl);
+ Add (Str => "^H -- delete previous char ^Y -- delete line");
+ Add (Ch => newl);
+ Add (Str => "^G -- delete current word ^C -- clear to end of line");
+ Add (Ch => newl);
+ Add (Str => "^K -- clear to end of field ^X -- clear field");
+ Add (Ch => newl);
+ Add (Str => "Arrow keys move within a field as you would expect.");
+
+ Add (Line => 4, Column => 57, Str => "Forms Entry Test");
+
+ Refresh;
+
+ -- describe the form
+ f (1) := make_label (0, 15, "Sample Form");
+ f (2) := make_label (2, 0, "Last Name");
+ f (3) := make_field (3, 0, 1, 18, False);
+ f (4) := make_label (2, 20, "First Name");
+ f (5) := make_field (3, 20, 1, 12, False);
+ f (6) := make_label (2, 34, "Middle Name");
+ f (7) := make_field (3, 34, 1, 12, False);
+ f (8) := make_label (5, 0, "Comments");
+ f (9) := make_field (6, 0, 4, 46, False);
+ f (10) := make_label (5, 20, "Password:");
+ f (11) := make_field (5, 30, 1, 9, True);
+ secure := f (11);
+ f (12) := Null_Field;
+
+ myform := New_Form (f);
+
+ display_form (myform);
+
+ w := Get_Window (myform);
+ Set_Raw_Mode (SwitchOn => True);
+ Set_NL_Mode (SwitchOn => True); -- lets us read ^M's
+ while not finished loop
+ c := form_virtualize (myform, w);
+ result := Driver (myform, c);
+ case result is
+ when Form_Ok =>
+ Add (Line => 5, Column => 57, Str => Get_Buffer (secure, 1));
+ Clear_To_End_Of_Line;
+ Refresh;
+ when Unknown_Request =>
+ finished := my_form_driver (myform, c);
+ when others =>
+ Beep;
+ end case;
+ end loop;
+
+ erase_form (myform);
+
+ -- TODO Free_Form(myform);
+ -- for (c = 0; f[c] != 0; c++) free_field(f[c]);
+ Set_Raw_Mode (SwitchOn => False);
+ Set_NL_Mode (SwitchOn => True);
+
+end ncurses2.demo_forms;
diff --git a/Ada95/samples/ncurses2-demo_forms.ads b/Ada95/samples/ncurses2-demo_forms.ads
new file mode 100644
index 0000000..eabaa01
--- /dev/null
+++ b/Ada95/samples/ncurses2-demo_forms.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+procedure ncurses2.demo_forms;
diff --git a/Ada95/samples/ncurses2-demo_pad.adb b/Ada95/samples/ncurses2-demo_pad.adb
new file mode 100644
index 0000000..862b8b7
--- /dev/null
+++ b/Ada95/samples/ncurses2-demo_pad.adb
@@ -0,0 +1,675 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.7 $
+-- $Date: 2008/07/26 18:47:06 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with ncurses2.util; use ncurses2.util;
+
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+
+with Interfaces.C;
+with System.Storage_Elements;
+with System.Address_To_Access_Conversions;
+
+with Ada.Text_IO;
+-- with Ada.Real_Time; use Ada.Real_Time;
+-- TODO is there a way to use Real_Time or Ada.Calendar in place of
+-- gettimeofday?
+
+-- Demonstrate pads.
+procedure ncurses2.demo_pad is
+
+ type timestruct is record
+ seconds : Integer;
+ microseconds : Integer;
+ end record;
+
+ type myfunc is access function (w : Window) return Key_Code;
+
+ function gettime return timestruct;
+ procedure do_h_line (y : Line_Position;
+ x : Column_Position;
+ c : Attributed_Character;
+ to : Column_Position);
+ procedure do_v_line (y : Line_Position;
+ x : Column_Position;
+ c : Attributed_Character;
+ to : Line_Position);
+ function padgetch (win : Window) return Key_Code;
+ function panner_legend (line : Line_Position) return Boolean;
+ procedure panner_legend (line : Line_Position);
+ procedure panner_h_cleanup (from_y : Line_Position;
+ from_x : Column_Position;
+ to_x : Column_Position);
+ procedure panner_v_cleanup (from_y : Line_Position;
+ from_x : Column_Position;
+ to_y : Line_Position);
+ procedure panner (pad : Window;
+ top_xp : Column_Position;
+ top_yp : Line_Position;
+ portyp : Line_Position;
+ portxp : Column_Position;
+ pgetc : myfunc);
+
+ function gettime return timestruct is
+
+ retval : timestruct;
+
+ use Interfaces.C;
+ type timeval is record
+ tv_sec : long;
+ tv_usec : long;
+ end record;
+ pragma Convention (C, timeval);
+
+ -- TODO function from_timeval is new Ada.Unchecked_Conversion(
+ -- timeval_a, System.Storage_Elements.Integer_Address);
+ -- should Interfaces.C.Pointers be used here?
+
+ package myP is new System.Address_To_Access_Conversions (timeval);
+ use myP;
+
+ t : constant Object_Pointer := new timeval;
+
+ function gettimeofday
+ (TP : System.Storage_Elements.Integer_Address;
+ TZP : System.Storage_Elements.Integer_Address) return int;
+ pragma Import (C, gettimeofday, "gettimeofday");
+ tmp : int;
+ begin
+ tmp := gettimeofday (System.Storage_Elements.To_Integer
+ (myP.To_Address (t)),
+ System.Storage_Elements.To_Integer
+ (myP.To_Address (null)));
+ if tmp < 0 then
+ retval.seconds := 0;
+ retval.microseconds := 0;
+ else
+ retval.seconds := Integer (t.tv_sec);
+ retval.microseconds := Integer (t.tv_usec);
+ end if;
+ return retval;
+ end gettime;
+
+ -- in C, The behavior of mvhline, mvvline for negative/zero length is
+ -- unspecified, though we can rely on negative x/y values to stop the
+ -- macro. Except Ada makes Line_Position(-1) = Natural - 1 so forget it.
+ procedure do_h_line (y : Line_Position;
+ x : Column_Position;
+ c : Attributed_Character;
+ to : Column_Position) is
+ begin
+ if to > x then
+ Move_Cursor (Line => y, Column => x);
+ Horizontal_Line (Line_Size => Natural (to - x), Line_Symbol => c);
+ end if;
+ end do_h_line;
+
+ procedure do_v_line (y : Line_Position;
+ x : Column_Position;
+ c : Attributed_Character;
+ to : Line_Position) is
+ begin
+ if to > y then
+ Move_Cursor (Line => y, Column => x);
+ Vertical_Line (Line_Size => Natural (to - y), Line_Symbol => c);
+ end if;
+ end do_v_line;
+
+ function padgetch (win : Window) return Key_Code is
+ c : Key_Code;
+ c2 : Character;
+ begin
+ c := Getchar (win);
+ c2 := Code_To_Char (c);
+
+ case c2 is
+ when '!' =>
+ ShellOut (False);
+ return Key_Refresh;
+ when Character'Val (Character'Pos ('r') mod 16#20#) => -- CTRL('r')
+ End_Windows;
+ Refresh;
+ return Key_Refresh;
+ when Character'Val (Character'Pos ('l') mod 16#20#) => -- CTRL('l')
+ return Key_Refresh;
+ when 'U' =>
+ return Key_Cursor_Up;
+ when 'D' =>
+ return Key_Cursor_Down;
+ when 'R' =>
+ return Key_Cursor_Right;
+ when 'L' =>
+ return Key_Cursor_Left;
+ when '+' =>
+ return Key_Insert_Line;
+ when '-' =>
+ return Key_Delete_Line;
+ when '>' =>
+ return Key_Insert_Char;
+ when '<' =>
+ return Key_Delete_Char;
+ -- when ERR=> /* FALLTHRU */
+ when 'q' =>
+ return (Key_Exit);
+ when others =>
+ return (c);
+ end case;
+ end padgetch;
+
+ show_panner_legend : Boolean := True;
+
+ function panner_legend (line : Line_Position) return Boolean is
+ legend : constant array (0 .. 3) of String (1 .. 61) :=
+ (
+ "Use arrow keys (or U,D,L,R) to pan, q to quit (?,t,s flags) ",
+ "Use ! to shell-out. Toggle legend:?, timer:t, scroll mark:s.",
+ "Use +,- (or j,k) to grow/shrink the panner vertically. ",
+ "Use <,> (or h,l) to grow/shrink the panner horizontally. ");
+ legendsize : constant := 4;
+
+ n : constant Integer := legendsize - Integer (Lines - line);
+ begin
+ if line < Lines and n >= 0 then
+ Move_Cursor (Line => line, Column => 0);
+ if show_panner_legend then
+ Add (Str => legend (n));
+ end if;
+ Clear_To_End_Of_Line;
+ return show_panner_legend;
+ end if;
+ return False;
+ end panner_legend;
+
+ procedure panner_legend (line : Line_Position) is
+ begin
+ if not panner_legend (line) then
+ Beep;
+ end if;
+ end panner_legend;
+
+ procedure panner_h_cleanup (from_y : Line_Position;
+ from_x : Column_Position;
+ to_x : Column_Position) is
+ begin
+ if not panner_legend (from_y) then
+ do_h_line (from_y, from_x, Blank2, to_x);
+ end if;
+ end panner_h_cleanup;
+
+ procedure panner_v_cleanup (from_y : Line_Position;
+ from_x : Column_Position;
+ to_y : Line_Position) is
+ begin
+ if not panner_legend (from_y) then
+ do_v_line (from_y, from_x, Blank2, to_y);
+ end if;
+ end panner_v_cleanup;
+
+ procedure panner (pad : Window;
+ top_xp : Column_Position;
+ top_yp : Line_Position;
+ portyp : Line_Position;
+ portxp : Column_Position;
+ pgetc : myfunc) is
+
+ function f (y : Line_Position) return Line_Position;
+ function f (x : Column_Position) return Column_Position;
+ function greater (y1, y2 : Line_Position) return Integer;
+ function greater (x1, x2 : Column_Position) return Integer;
+
+ top_x : Column_Position := top_xp;
+ top_y : Line_Position := top_yp;
+ porty : Line_Position := portyp;
+ portx : Column_Position := portxp;
+
+ -- f[x] returns max[x - 1, 0]
+ function f (y : Line_Position) return Line_Position is
+ begin
+ if y > 0 then
+ return y - 1;
+ else
+ return y; -- 0
+ end if;
+ end f;
+
+ function f (x : Column_Position) return Column_Position is
+ begin
+ if x > 0 then
+ return x - 1;
+ else
+ return x; -- 0
+ end if;
+ end f;
+
+ function greater (y1, y2 : Line_Position) return Integer is
+ begin
+ if y1 > y2 then
+ return 1;
+ else
+ return 0;
+ end if;
+ end greater;
+
+ function greater (x1, x2 : Column_Position) return Integer is
+ begin
+ if x1 > x2 then
+ return 1;
+ else
+ return 0;
+ end if;
+ end greater;
+
+ pymax : Line_Position;
+ basey : Line_Position := 0;
+ pxmax : Column_Position;
+ basex : Column_Position := 0;
+ c : Key_Code;
+ scrollers : Boolean := True;
+ before, after : timestruct;
+ timing : Boolean := True;
+
+ package floatio is new Ada.Text_IO.Float_IO (Long_Float);
+ begin
+ Get_Size (pad, pymax, pxmax);
+ Allow_Scrolling (Mode => False); -- we don't want stdscr to scroll!
+
+ c := Key_Refresh;
+ loop
+ -- During shell-out, the user may have resized the window. Adjust
+ -- the port size of the pad to accommodate this. Ncurses
+ -- automatically resizes all of the normal windows to fit on the
+ -- new screen.
+ if top_x > Columns then
+ top_x := Columns;
+ end if;
+ if portx > Columns then
+ portx := Columns;
+ end if;
+ if top_y > Lines then
+ top_y := Lines;
+ end if;
+ if porty > Lines then
+ porty := Lines;
+ end if;
+
+ case c is
+ when Key_Refresh | Character'Pos ('?') =>
+ if c = Key_Refresh then
+ Erase;
+ else -- '?'
+ show_panner_legend := not show_panner_legend;
+ end if;
+ panner_legend (Lines - 4);
+ panner_legend (Lines - 3);
+ panner_legend (Lines - 2);
+ panner_legend (Lines - 1);
+ when Character'Pos ('t') =>
+ timing := not timing;
+ if not timing then
+ panner_legend (Lines - 1);
+ end if;
+ when Character'Pos ('s') =>
+ scrollers := not scrollers;
+
+ -- Move the top-left corner of the pad, keeping the
+ -- bottom-right corner fixed.
+ when Character'Pos ('h') =>
+ -- increase-columns: move left edge to left
+ if top_x = 0 then
+ Beep;
+ else
+ panner_v_cleanup (top_y, top_x, porty);
+ top_x := top_x - 1;
+ end if;
+
+ when Character'Pos ('j') =>
+ -- decrease-lines: move top-edge down
+ if top_y >= porty then
+ Beep;
+ else
+ if top_y /= 0 then
+ panner_h_cleanup (top_y - 1, f (top_x), portx);
+ end if;
+ top_y := top_y + 1;
+ end if;
+ when Character'Pos ('k') =>
+ -- increase-lines: move top-edge up
+ if top_y = 0 then
+ Beep;
+ else
+ top_y := top_y - 1;
+ panner_h_cleanup (top_y, top_x, portx);
+ end if;
+
+ when Character'Pos ('l') =>
+ -- decrease-columns: move left-edge to right
+ if top_x >= portx then
+ Beep;
+ else
+ if top_x /= 0 then
+ panner_v_cleanup (f (top_y), top_x - 1, porty);
+ end if;
+ top_x := top_x + 1;
+ end if;
+
+ -- Move the bottom-right corner of the pad, keeping the
+ -- top-left corner fixed.
+ when Key_Insert_Char =>
+ -- increase-columns: move right-edge to right
+ if portx >= pxmax or portx >= Columns then
+ Beep;
+ else
+ panner_v_cleanup (f (top_y), portx - 1, porty);
+ portx := portx + 1;
+ -- C had ++portx instead of portx++, weird.
+ end if;
+ when Key_Insert_Line =>
+ -- increase-lines: move bottom-edge down
+ if porty >= pymax or porty >= Lines then
+ Beep;
+ else
+ panner_h_cleanup (porty - 1, f (top_x), portx);
+ porty := porty + 1;
+ end if;
+
+ when Key_Delete_Char =>
+ -- decrease-columns: move bottom edge up
+ if portx <= top_x then
+ Beep;
+ else
+ portx := portx - 1;
+ panner_v_cleanup (f (top_y), portx, porty);
+ end if;
+
+ when Key_Delete_Line =>
+ -- decrease-lines
+ if porty <= top_y then
+ Beep;
+ else
+ porty := porty - 1;
+ panner_h_cleanup (porty, f (top_x), portx);
+ end if;
+ when Key_Cursor_Left =>
+ -- pan leftwards
+ if basex > 0 then
+ basex := basex - 1;
+ else
+ Beep;
+ end if;
+ when Key_Cursor_Right =>
+ -- pan rightwards
+ -- if (basex + portx - (pymax > porty) < pxmax)
+ if basex + portx -
+ Column_Position (greater (pymax, porty)) < pxmax then
+ -- if basex + portx < pxmax or
+ -- (pymax > porty and basex + portx - 1 < pxmax) then
+ basex := basex + 1;
+ else
+ Beep;
+ end if;
+
+ when Key_Cursor_Up =>
+ -- pan upwards
+ if basey > 0 then
+ basey := basey - 1;
+ else
+ Beep;
+ end if;
+
+ when Key_Cursor_Down =>
+ -- pan downwards
+ -- same as if (basey + porty - (pxmax > portx) < pymax)
+ if basey + porty -
+ Line_Position (greater (pxmax, portx)) < pymax then
+ -- if (basey + porty < pymax) or
+ -- (pxmax > portx and basey + porty - 1 < pymax) then
+ basey := basey + 1;
+ else
+ Beep;
+ end if;
+
+ when Character'Pos ('H') |
+ Key_Home |
+ Key_Find =>
+ basey := 0;
+
+ when Character'Pos ('E') |
+ Key_End |
+ Key_Select =>
+ if pymax < porty then
+ basey := 0;
+ else
+ basey := pymax - porty;
+ end if;
+
+ when others =>
+ Beep;
+ end case;
+
+ -- more writing off the screen.
+ -- Interestingly, the exception is not handled if
+ -- we put a block around this.
+ -- delcare --begin
+ if top_y /= 0 and top_x /= 0 then
+ Add (Line => top_y - 1, Column => top_x - 1,
+ Ch => ACS_Map (ACS_Upper_Left_Corner));
+ end if;
+ if top_x /= 0 then
+ do_v_line (top_y, top_x - 1, ACS_Map (ACS_Vertical_Line), porty);
+ end if;
+ if top_y /= 0 then
+ do_h_line (top_y - 1, top_x, ACS_Map (ACS_Horizontal_Line), portx);
+ end if;
+ -- exception when Curses_Exception => null; end;
+
+ -- in C was ... pxmax > portx - 1
+ if scrollers and pxmax >= portx then
+ declare
+ length : constant Column_Position := portx - top_x - 1;
+ lowend, highend : Column_Position;
+ begin
+ -- Instead of using floats, I'll use integers only.
+ lowend := top_x + (basex * length) / pxmax;
+ highend := top_x + ((basex + length) * length) / pxmax;
+
+ do_h_line (porty - 1, top_x, ACS_Map (ACS_Horizontal_Line),
+ lowend);
+ if highend < portx then
+ Switch_Character_Attribute
+ (Attr => (Reverse_Video => True, others => False),
+ On => True);
+ do_h_line (porty - 1, lowend, Blank2, highend + 1);
+ Switch_Character_Attribute
+ (Attr => (Reverse_Video => True, others => False),
+ On => False);
+ do_h_line (porty - 1, highend + 1,
+ ACS_Map (ACS_Horizontal_Line), portx);
+ end if;
+ end;
+ else
+ do_h_line (porty - 1, top_x, ACS_Map (ACS_Horizontal_Line), portx);
+ end if;
+
+ if scrollers and pymax >= porty then
+ declare
+ length : constant Line_Position := porty - top_y - 1;
+ lowend, highend : Line_Position;
+ begin
+ lowend := top_y + (basey * length) / pymax;
+ highend := top_y + ((basey + length) * length) / pymax;
+
+ do_v_line (top_y, portx - 1, ACS_Map (ACS_Vertical_Line),
+ lowend);
+ if highend < porty then
+ Switch_Character_Attribute
+ (Attr => (Reverse_Video => True, others => False),
+ On => True);
+ do_v_line (lowend, portx - 1, Blank2, highend + 1);
+ Switch_Character_Attribute
+ (Attr => (Reverse_Video => True, others => False),
+ On => False);
+ do_v_line (highend + 1, portx - 1,
+ ACS_Map (ACS_Vertical_Line), porty);
+ end if;
+ end;
+ else
+ do_v_line (top_y, portx - 1, ACS_Map (ACS_Vertical_Line), porty);
+ end if;
+
+ if top_y /= 0 then
+ Add (Line => top_y - 1, Column => portx - 1,
+ Ch => ACS_Map (ACS_Upper_Right_Corner));
+ end if;
+ if top_x /= 0 then
+ Add (Line => porty - 1, Column => top_x - 1,
+ Ch => ACS_Map (ACS_Lower_Left_Corner));
+ end if;
+ declare
+ begin
+ -- Here is another place where it is possible
+ -- to write to the corner of the screen.
+ Add (Line => porty - 1, Column => portx - 1,
+ Ch => ACS_Map (ACS_Lower_Right_Corner));
+ exception
+ when Curses_Exception => null;
+ end;
+
+ before := gettime;
+
+ Refresh_Without_Update;
+
+ declare
+ -- the C version allows the panel to have a zero height
+ -- wich raise the exception
+ begin
+ Refresh_Without_Update
+ (
+ pad,
+ basey, basex,
+ top_y, top_x,
+ porty - Line_Position (greater (pxmax, portx)) - 1,
+ portx - Column_Position (greater (pymax, porty)) - 1);
+ exception
+ when Curses_Exception => null;
+ end;
+
+ Update_Screen;
+
+ if timing then
+ declare
+ s : String (1 .. 7);
+ elapsed : Long_Float;
+ begin
+ after := gettime;
+ elapsed := (Long_Float (after.seconds - before.seconds) +
+ Long_Float (after.microseconds
+ - before.microseconds)
+ / 1.0e6);
+ Move_Cursor (Line => Lines - 1, Column => Columns - 20);
+ floatio.Put (s, elapsed, Aft => 3, Exp => 0);
+ Add (Str => s);
+ Refresh;
+ end;
+ end if;
+
+ c := pgetc (pad);
+ exit when c = Key_Exit;
+
+ end loop;
+
+ Allow_Scrolling (Mode => True);
+
+ end panner;
+
+ Gridsize : constant := 3;
+ Gridcount : Integer := 0;
+
+ Pad_High : constant Line_Count := 200;
+ Pad_Wide : constant Column_Count := 200;
+ panpad : Window := New_Pad (Pad_High, Pad_Wide);
+begin
+ if panpad = Null_Window then
+ Cannot ("cannot create requested pad");
+ return;
+ end if;
+
+ for i in 0 .. Pad_High - 1 loop
+ for j in 0 .. Pad_Wide - 1 loop
+ if i mod Gridsize = 0 and j mod Gridsize = 0 then
+ if i = 0 or j = 0 then
+ Add (panpad, '+');
+ else
+ -- depends on ASCII?
+ Add (panpad,
+ Ch => Character'Val (Character'Pos ('A') +
+ Gridcount mod 26));
+ Gridcount := Gridcount + 1;
+ end if;
+ elsif i mod Gridsize = 0 then
+ Add (panpad, '-');
+ elsif j mod Gridsize = 0 then
+ Add (panpad, '|');
+ else
+ declare
+ -- handle the write to the lower right corner error
+ begin
+ Add (panpad, ' ');
+ exception
+ when Curses_Exception => null;
+ end;
+ end if;
+ end loop;
+ end loop;
+ panner_legend (Lines - 4);
+ panner_legend (Lines - 3);
+ panner_legend (Lines - 2);
+ panner_legend (Lines - 1);
+
+ Set_KeyPad_Mode (panpad, True);
+ -- Make the pad (initially) narrow enough that a trace file won't wrap.
+ -- We'll still be able to widen it during a test, since that's required
+ -- for testing boundaries.
+
+ panner (panpad, 2, 2, Lines - 5, Columns - 15, padgetch'Access);
+
+ Delete (panpad);
+ End_Windows; -- Hmm, Erase after End_Windows
+ Erase;
+end ncurses2.demo_pad;
diff --git a/Ada95/samples/ncurses2-demo_pad.ads b/Ada95/samples/ncurses2-demo_pad.ads
new file mode 100644
index 0000000..b996263
--- /dev/null
+++ b/Ada95/samples/ncurses2-demo_pad.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+procedure ncurses2.demo_pad;
diff --git a/Ada95/samples/ncurses2-demo_panels.adb b/Ada95/samples/ncurses2-demo_panels.adb
new file mode 100644
index 0000000..d2558ed
--- /dev/null
+++ b/Ada95/samples/ncurses2-demo_panels.adb
@@ -0,0 +1,382 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-2004,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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.6 $
+-- $Date: 2008/08/30 23:35:01 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with ncurses2.util; use ncurses2.util;
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
+with Terminal_Interface.Curses.Panels.User_Data;
+
+with ncurses2.genericPuts;
+
+procedure ncurses2.demo_panels (nap_mseci : Integer) is
+ use Int_IO;
+
+ function mkpanel (color : Color_Number;
+ rows : Line_Count;
+ cols : Column_Count;
+ tly : Line_Position;
+ tlx : Column_Position) return Panel;
+ procedure rmpanel (pan : in out Panel);
+ procedure pflush;
+ procedure wait_a_while (msec : Integer);
+ procedure saywhat (text : String);
+ procedure fill_panel (pan : Panel);
+
+ nap_msec : Integer := nap_mseci;
+
+ function mkpanel (color : Color_Number;
+ rows : Line_Count;
+ cols : Column_Count;
+ tly : Line_Position;
+ tlx : Column_Position) return Panel is
+ win : Window;
+ pan : Panel := Null_Panel;
+ begin
+ win := New_Window (rows, cols, tly, tlx);
+ if Null_Window /= win then
+ pan := New_Panel (win);
+ if pan = Null_Panel then
+ Delete (win);
+ elsif Has_Colors then
+ declare
+ fg, bg : Color_Number;
+ begin
+ if color = Blue then
+ fg := White;
+ else
+ fg := Black;
+ end if;
+ bg := color;
+ Init_Pair (Color_Pair (color), fg, bg);
+ Set_Background (win, (Ch => ' ',
+ Attr => Normal_Video,
+ Color => Color_Pair (color)));
+ end;
+ else
+ Set_Background (win, (Ch => ' ',
+ Attr => (Bold_Character => True,
+ others => False),
+ Color => Color_Pair (color)));
+ end if;
+ end if;
+ return pan;
+ end mkpanel;
+
+ procedure rmpanel (pan : in out Panel) is
+ win : Window := Panel_Window (pan);
+ begin
+ Delete (pan);
+ Delete (win);
+ end rmpanel;
+
+ procedure pflush is
+ begin
+ Update_Panels;
+ Update_Screen;
+ end pflush;
+
+ procedure wait_a_while (msec : Integer) is
+ begin
+ -- The C version had some #ifdef blocks here
+ if msec = 1 then
+ Getchar;
+ else
+ Nap_Milli_Seconds (msec);
+ end if;
+ end wait_a_while;
+
+ procedure saywhat (text : String) is
+ begin
+ Move_Cursor (Line => Lines - 1, Column => 0);
+ Clear_To_End_Of_Line;
+ Add (Str => text);
+ end saywhat;
+
+ -- from sample-curses_demo.adb
+ type User_Data is new String (1 .. 2);
+ type User_Data_Access is access all User_Data;
+ package PUD is new Panels.User_Data (User_Data, User_Data_Access);
+
+ use PUD;
+
+ procedure fill_panel (pan : Panel) is
+ win : constant Window := Panel_Window (pan);
+ num : constant Character := Get_User_Data (pan) (2);
+ tmp6 : String (1 .. 6) := "-panx-";
+ maxy : Line_Count;
+ maxx : Column_Count;
+
+ begin
+ Move_Cursor (win, 1, 1);
+ tmp6 (5) := num;
+ Add (win, Str => tmp6);
+ Clear_To_End_Of_Line (win);
+ Box (win);
+ Get_Size (win, maxy, maxx);
+ for y in 2 .. maxy - 3 loop
+ for x in 1 .. maxx - 3 loop
+ Move_Cursor (win, y, x);
+ Add (win, num);
+ end loop;
+ end loop;
+ exception
+ when Curses_Exception => null;
+ end fill_panel;
+
+ modstr : constant array (0 .. 5) of String (1 .. 5) :=
+ ("test ",
+ "TEST ",
+ "(**) ",
+ "*()* ",
+ "<--> ",
+ "LAST "
+ );
+
+ package p is new ncurses2.genericPuts (1024);
+ use p;
+ use p.BS;
+ -- the C version said register int y, x;
+ tmpb : BS.Bounded_String;
+
+begin
+ Refresh;
+
+ for y in 0 .. Integer (Lines - 2) loop
+ for x in 0 .. Integer (Columns - 1) loop
+ myPut (tmpb, (y + x) mod 10);
+ myAdd (Str => tmpb);
+ end loop;
+ end loop;
+ for y in 0 .. 4 loop
+ declare
+ p1, p2, p3, p4, p5 : Panel;
+ U1 : constant User_Data_Access := new User_Data'("p1");
+ U2 : constant User_Data_Access := new User_Data'("p2");
+ U3 : constant User_Data_Access := new User_Data'("p3");
+ U4 : constant User_Data_Access := new User_Data'("p4");
+ U5 : constant User_Data_Access := new User_Data'("p5");
+
+ begin
+ p1 := mkpanel (Red, Lines / 2 - 2, Columns / 8 + 1, 0, 0);
+ Set_User_Data (p1, U1);
+ p2 := mkpanel (Green, Lines / 2 + 1, Columns / 7, Lines / 4,
+ Columns / 10);
+ Set_User_Data (p2, U2);
+ p3 := mkpanel (Yellow, Lines / 4, Columns / 10, Lines / 2,
+ Columns / 9);
+ Set_User_Data (p3, U3);
+ p4 := mkpanel (Blue, Lines / 2 - 2, Columns / 8, Lines / 2 - 2,
+ Columns / 3);
+ Set_User_Data (p4, U4);
+ p5 := mkpanel (Magenta, Lines / 2 - 2, Columns / 8, Lines / 2,
+ Columns / 2 - 2);
+ Set_User_Data (p5, U5);
+
+ fill_panel (p1);
+ fill_panel (p2);
+ fill_panel (p3);
+ fill_panel (p4);
+ fill_panel (p5);
+ Hide (p4);
+ Hide (p5);
+ pflush;
+ saywhat ("press any key to continue");
+ wait_a_while (nap_msec);
+
+ saywhat ("h3 s1 s2 s4 s5; press any key to continue");
+ Move (p1, 0, 0);
+ Hide (p3);
+ Show (p1);
+ Show (p2);
+ Show (p4);
+ Show (p5);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("s1; press any key to continue");
+ Show (p1);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("s2; press any key to continue");
+ Show (p2);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("m2; press any key to continue");
+ Move (p2, Lines / 3 + 1, Columns / 8);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("s3;");
+ Show (p3);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("m3; press any key to continue");
+ Move (p3, Lines / 4 + 1, Columns / 15);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("b3; press any key to continue");
+ Bottom (p3);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("s4; press any key to continue");
+ Show (p4);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("s5; press any key to continue");
+ Show (p5);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("t3; press any key to continue");
+ Top (p3);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("t1; press any key to continue");
+ Top (p1);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("t2; press any key to continue");
+ Top (p2);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("t3; press any key to continue");
+ Top (p3);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("t4; press any key to continue");
+ Top (p4);
+ pflush;
+ wait_a_while (nap_msec);
+
+ for itmp in 0 .. 5 loop
+ declare
+ w4 : constant Window := Panel_Window (p4);
+ w5 : constant Window := Panel_Window (p5);
+ begin
+
+ saywhat ("m4; press any key to continue");
+ Move_Cursor (w4, Lines / 8, 1);
+ Add (w4, modstr (itmp));
+ Move (p4, Lines / 6, Column_Position (itmp) * (Columns / 8));
+ Move_Cursor (w5, Lines / 6, 1);
+ Add (w5, modstr (itmp));
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("m5; press any key to continue");
+ Move_Cursor (w4, Lines / 6, 1);
+ Add (w4, modstr (itmp));
+ Move (p5, Lines / 3 - 1, (Column_Position (itmp) * 10) + 6);
+ Move_Cursor (w5, Lines / 8, 1);
+ Add (w5, modstr (itmp));
+ pflush;
+ wait_a_while (nap_msec);
+ end;
+ end loop;
+
+ saywhat ("m4; press any key to continue");
+ Move (p4, Lines / 6, 6 * (Columns / 8));
+ -- Move(p4, Lines / 6, itmp * (Columns / 8));
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("t5; press any key to continue");
+ Top (p5);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("t2; press any key to continue");
+ Top (p2);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("t1; press any key to continue");
+ Top (p1);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("d2; press any key to continue");
+ rmpanel (p2);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("h3; press any key to continue");
+ Hide (p3);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("d1; press any key to continue");
+ rmpanel (p1);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("d4; press any key to continue");
+ rmpanel (p4);
+ pflush;
+ wait_a_while (nap_msec);
+
+ saywhat ("d5; press any key to continue");
+ rmpanel (p5);
+ pflush;
+ wait_a_while (nap_msec);
+ if nap_msec = 1 then
+ exit;
+ else
+ nap_msec := 100;
+ end if;
+
+ end;
+ end loop;
+
+ Erase;
+ End_Windows;
+
+end ncurses2.demo_panels;
diff --git a/Ada95/samples/ncurses2-demo_panels.ads b/Ada95/samples/ncurses2-demo_panels.ads
new file mode 100644
index 0000000..eb2878c
--- /dev/null
+++ b/Ada95/samples/ncurses2-demo_panels.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+procedure ncurses2.demo_panels (nap_mseci : Integer);
diff --git a/Ada95/samples/ncurses2-flushinp_test.adb b/Ada95/samples/ncurses2-flushinp_test.adb
new file mode 100644
index 0000000..9ea98e1
--- /dev/null
+++ b/Ada95/samples/ncurses2-flushinp_test.adb
@@ -0,0 +1,135 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with ncurses2.util; use ncurses2.util;
+
+procedure ncurses2.flushinp_test (win : Window) is
+
+ procedure Continue (win : Window);
+
+ procedure Continue (win : Window) is
+ begin
+ Set_Echo_Mode (False);
+ Move_Cursor (win, 10, 1);
+ Add (win, 10, 1, " Press any key to continue");
+ Refresh (win);
+ Getchar (win);
+ end Continue;
+
+ h, by, sh : Line_Position;
+ w, bx, sw : Column_Position;
+
+ subWin : Window;
+
+begin
+ Clear (win);
+ Get_Size (win, h, w);
+ Get_Window_Position (win, by, bx);
+ sw := w / 3;
+ sh := h / 3;
+ subWin := Sub_Window (win, sh, sw, by + h - sh - 2, bx + w - sw - 2);
+
+ if Has_Colors then
+ Init_Pair (2, Cyan, Blue);
+ Change_Background (subWin,
+ Attributed_Character'(Ch => ' ', Color => 2,
+ Attr => Normal_Video));
+ end if;
+
+ Set_Character_Attributes (subWin,
+ (Bold_Character => True, others => False));
+ Box (subWin);
+ Add (subWin, 2, 1, "This is a subwindow");
+ Refresh (win);
+
+ Set_Cbreak_Mode (True);
+ Add (win, 0, 1, "This is a test of the flushinp() call.");
+
+ Add (win, 2, 1, "Type random keys for 5 seconds.");
+ Add (win, 3, 1,
+ "These should be discarded (not echoed) after the subwindow " &
+ "goes away.");
+ Refresh (win);
+
+ for i in 0 .. 4 loop
+ Move_Cursor (subWin, 1, 1);
+ Add (subWin, Str => "Time = ");
+ Add (subWin, Str => Integer'Image (i));
+ Refresh (subWin);
+ Nap_Milli_Seconds (1000);
+ Flush_Input;
+ end loop;
+
+ Delete (subWin);
+ Erase (win);
+ Flash_Screen;
+ Refresh (win);
+ Nap_Milli_Seconds (1000);
+
+ Add (win, 2, 1,
+ Str => "If you were still typing when the window timer expired,");
+ Add (win, 3, 1,
+ "or else you typed nothing at all while it was running,");
+ Add (win, 4, 1,
+ "test was invalid. You'll see garbage or nothing at all. ");
+ Add (win, 6, 1, "Press a key");
+ Move_Cursor (win, 9, 10);
+ Refresh (win);
+ Set_Echo_Mode (True);
+ Getchar (win);
+ Flush_Input;
+ Add (win, 12, 0,
+ "If you see any key other than what you typed, flushinp() is broken.");
+ Continue (win);
+
+ Move_Cursor (win, 9, 10);
+ Delete_Character (win);
+ Refresh (win);
+ Move_Cursor (win, 12, 0);
+ Clear_To_End_Of_Line;
+ Add (win,
+ "What you typed should now have been deleted; if not, wdelch() " &
+ "failed.");
+ Continue (win);
+
+ Set_Cbreak_Mode (True);
+
+end ncurses2.flushinp_test;
diff --git a/Ada95/samples/ncurses2-flushinp_test.ads b/Ada95/samples/ncurses2-flushinp_test.ads
new file mode 100644
index 0000000..5376c94
--- /dev/null
+++ b/Ada95/samples/ncurses2-flushinp_test.ads
@@ -0,0 +1,43 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses;
+
+procedure ncurses2.flushinp_test (win : Terminal_Interface.Curses.Window);
diff --git a/Ada95/samples/ncurses2-genericputs.adb b/Ada95/samples/ncurses2-genericputs.adb
new file mode 100644
index 0000000..6ca6583
--- /dev/null
+++ b/Ada95/samples/ncurses2-genericputs.adb
@@ -0,0 +1,117 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.3 $
+-- $Date: 2008/07/26 18:46:18 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+
+package body ncurses2.genericPuts is
+
+ procedure myGet (Win : in Window := Standard_Window;
+ Str : out BS.Bounded_String;
+ Len : in Integer := -1)
+ is
+ function Wgetnstr (Win : Window;
+ Str : char_array;
+ Len : int) return int;
+ pragma Import (C, Wgetnstr, "wgetnstr");
+
+ N : Integer := Len;
+ Txt : char_array (0 .. size_t (Max_Length));
+ xStr : String (1 .. Max_Length);
+ Cnt : Natural;
+ begin
+ if N < 0 then
+ N := Max_Length;
+ end if;
+ if N > Max_Length then
+ raise Constraint_Error;
+ end if;
+ Txt (0) := Interfaces.C.char'First;
+ if Wgetnstr (Win, Txt, C_Int (N)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ To_Ada (Txt, xStr, Cnt, True);
+ Str := To_Bounded_String (xStr (1 .. Cnt));
+ end myGet;
+
+ procedure myPut (Str : out BS.Bounded_String;
+ i : Integer;
+ Base : in Number_Base := 10) is
+ package Int_IO is new Integer_IO (Integer); use Int_IO;
+ tmp : String (1 .. BS.Max_Length);
+ begin
+ Put (tmp, i, Base);
+ Str := To_Bounded_String (tmp);
+ Trim (Str, Ada.Strings.Trim_End'(Ada.Strings.Left));
+ end myPut;
+
+ procedure myAdd (Str : BS.Bounded_String) is
+ begin
+ Add (Str => To_String (Str));
+ end myAdd;
+
+ -- from ncurses-aux
+ procedure Fill_String (Cp : in chars_ptr;
+ Str : out BS.Bounded_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 Max_Length < Len then
+ raise Constraint_Error;
+ end if;
+ declare
+ S : String (1 .. Len);
+ begin
+ S := Value (Cp);
+ Str := To_Bounded_String (S);
+ end;
+ else
+ Str := Null_Bounded_String;
+ end if;
+
+ end Fill_String;
+
+end ncurses2.genericPuts;
diff --git a/Ada95/samples/ncurses2-genericputs.ads b/Ada95/samples/ncurses2-genericputs.ads
new file mode 100644
index 0000000..1614a11
--- /dev/null
+++ b/Ada95/samples/ncurses2-genericputs.ads
@@ -0,0 +1,72 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000,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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.2 $
+-- $Date: 2006/06/25 14:24:40 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Strings.Bounded;
+use Ada.Strings.Bounded;
+with Interfaces.C; use Interfaces.C;
+with Interfaces.C.Strings; use Interfaces.C.Strings;
+with Terminal_Interface.Curses;
+
+generic
+ Max : Natural;
+ -- type mystring is private;
+ -- type myint is
+package ncurses2.genericPuts is
+ package BS is new
+ Ada.Strings.Bounded.Generic_Bounded_Length (Max);
+ use BS;
+
+ procedure myGet (Win : in Terminal_Interface.Curses.Window
+ := Terminal_Interface.Curses.Standard_Window;
+ Str : out BS.Bounded_String;
+ Len : in Integer := -1);
+
+ procedure myPut (Str : out BS.Bounded_String;
+ i : Integer;
+ Base : in Number_Base := 10);
+ -- the default should be Ada.Text_IO.Integer_IO.Default_Base
+ -- but Default_Base is hidden in the generic so doesn't exist!
+ procedure myAdd (Str : BS.Bounded_String);
+
+ procedure Fill_String (Cp : in chars_ptr; Str : out BS.Bounded_String);
+end ncurses2.genericPuts;
diff --git a/Ada95/samples/ncurses2-getch.ads b/Ada95/samples/ncurses2-getch.ads
new file mode 100644
index 0000000..21a09f3
--- /dev/null
+++ b/Ada95/samples/ncurses2-getch.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+procedure getch_test;
diff --git a/Ada95/samples/ncurses2-getch_test.adb b/Ada95/samples/ncurses2-getch_test.adb
new file mode 100644
index 0000000..172312c
--- /dev/null
+++ b/Ada95/samples/ncurses2-getch_test.adb
@@ -0,0 +1,254 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.7 $
+-- $Date: 2008/07/26 18:46:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+-- Character input test
+-- test the keypad feature
+
+with ncurses2.util; use ncurses2.util;
+
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
+with Ada.Characters.Handling;
+with Ada.Strings.Bounded;
+
+with ncurses2.genericPuts;
+
+procedure ncurses2.getch_test is
+ use Int_IO;
+
+ function mouse_decode (ep : Mouse_Event) return String;
+
+ function mouse_decode (ep : Mouse_Event) return String is
+ Y : Line_Position;
+ X : Column_Position;
+ Button : Mouse_Button;
+ State : Button_State;
+ package BS is new Ada.Strings.Bounded.Generic_Bounded_Length (200);
+ use BS;
+ buf : Bounded_String := To_Bounded_String ("");
+ begin
+ -- Note that these bindings do not allow
+ -- two button states,
+ -- The C version can print {click-1, click-3} for example.
+ -- They also don't have the 'id' or z coordinate.
+ Get_Event (ep, Y, X, Button, State);
+
+ -- TODO Append (buf, "id "); from C version
+ Append (buf, "at (");
+ Append (buf, Column_Position'Image (X));
+ Append (buf, ", ");
+ Append (buf, Line_Position'Image (Y));
+ Append (buf, ") state");
+ Append (buf, Mouse_Button'Image (Button));
+
+ Append (buf, " = ");
+ Append (buf, Button_State'Image (State));
+ return To_String (buf);
+ end mouse_decode;
+
+ buf : String (1 .. 1024); -- TODO was BUFSIZE
+ n : Integer;
+ c : Key_Code;
+ blockflag : Timeout_Mode := Blocking;
+ firsttime : Boolean := True;
+ tmp2 : Event_Mask;
+ tmp6 : String (1 .. 6);
+ tmp20 : String (1 .. 20);
+ x : Column_Position;
+ y : Line_Position;
+ tmpx : Integer;
+ incount : Integer := 0;
+
+begin
+ Refresh;
+ tmp2 := Start_Mouse (All_Events);
+ Add (Str => "Delay in 10ths of a second (<CR> for blocking input)? ");
+ Set_Echo_Mode (SwitchOn => True);
+ Get (Str => buf);
+
+ Set_Echo_Mode (SwitchOn => False);
+ Set_NL_Mode (SwitchOn => False);
+
+ if Ada.Characters.Handling.Is_Digit (buf (1)) then
+ Get (Item => n, From => buf, Last => tmpx);
+ Set_Timeout_Mode (Mode => Delayed, Amount => n * 100);
+ blockflag := Delayed;
+ end if;
+
+ c := Character'Pos ('?');
+ Set_Raw_Mode (SwitchOn => True);
+ loop
+ if not firsttime then
+ Add (Str => "Key pressed: ");
+ Put (tmp6, Integer (c), 8);
+ Add (Str => tmp6);
+ Add (Ch => ' ');
+ if c = Key_Mouse then
+ declare
+ event : Mouse_Event;
+ begin
+ event := Get_Mouse;
+ Add (Str => "KEY_MOUSE, ");
+ Add (Str => mouse_decode (event));
+ Add (Ch => newl);
+ end;
+ elsif c >= Key_Min then
+ Key_Name (c, tmp20);
+ Add (Str => tmp20);
+ -- I used tmp and got bitten by the length problem:->
+ Add (Ch => newl);
+ elsif c > 16#80# then -- TODO fix, use constant if possible
+ declare
+ c2 : constant Character := Character'Val (c mod 16#80#);
+ begin
+ if Ada.Characters.Handling.Is_Graphic (c2) then
+ Add (Str => "M-");
+ Add (Ch => c2);
+ else
+ Add (Str => "M-");
+ Add (Str => Un_Control ((Ch => c2,
+ Color => Color_Pair'First,
+ Attr => Normal_Video)));
+ end if;
+ Add (Str => " (high-half character)");
+ Add (Ch => newl);
+ end;
+ else
+ declare
+ c2 : constant Character := Character'Val (c mod 16#80#);
+ begin
+ if Ada.Characters.Handling.Is_Graphic (c2) then
+ Add (Ch => c2);
+ Add (Str => " (ASCII printable character)");
+ Add (Ch => newl);
+ else
+ Add (Str => Un_Control ((Ch => c2,
+ Color => Color_Pair'First,
+ Attr => Normal_Video)));
+ Add (Str => " (ASCII control character)");
+ Add (Ch => newl);
+ end if;
+ end;
+ end if;
+ -- TODO I am not sure why this was in the C version
+ -- the delay statement scroll anyway.
+ Get_Cursor_Position (Line => y, Column => x);
+ if y >= Lines - 1 then
+ Move_Cursor (Line => 0, Column => 0);
+ end if;
+ Clear_To_End_Of_Line;
+ end if;
+
+ firsttime := False;
+ if c = Character'Pos ('g') then
+ declare
+ package p is new ncurses2.genericPuts (1024);
+ use p;
+ use p.BS;
+ timedout : Boolean := False;
+ boundedbuf : Bounded_String;
+ begin
+ Add (Str => "getstr test: ");
+ Set_Echo_Mode (SwitchOn => True);
+ -- Note that if delay mode is set
+ -- Get can raise an exception.
+ -- The C version would print the string it had so far
+ -- also TODO get longer length string, like the C version
+ declare begin
+ myGet (Str => boundedbuf);
+ exception when Curses_Exception =>
+ Add (Str => "Timed out.");
+ Add (Ch => newl);
+ timedout := True;
+ end;
+ -- note that the Ada Get will stop reading at 1024.
+ if not timedout then
+ Set_Echo_Mode (SwitchOn => False);
+ Add (Str => " I saw '");
+ myAdd (Str => boundedbuf);
+ Add (Str => "'.");
+ Add (ch => newl);
+ end if;
+ end;
+ elsif c = Character'Pos ('s') then
+ ShellOut (True);
+ elsif c = Character'Pos ('x') or c = Character'Pos ('q') or
+ (c = Key_None and blockflag = Blocking) then
+ exit;
+ elsif c = Character'Pos ('?') then
+ Add (Str => "Type any key to see its keypad value. Also:");
+ Add (Ch => newl);
+ Add (Str => "g -- triggers a getstr test");
+ Add (Ch => newl);
+ Add (Str => "s -- shell out");
+ Add (Ch => newl);
+ Add (Str => "q -- quit");
+ Add (Ch => newl);
+ Add (Str => "? -- repeats this help message");
+ Add (Ch => newl);
+ end if;
+
+ loop
+ c := Getchar;
+ exit when c /= Key_None;
+ if blockflag /= Blocking then
+ Put (tmp6, incount); -- argh string length!
+ Add (Str => tmp6);
+ Add (Str => ": input timed out");
+ Add (Ch => newl);
+ else
+ Put (tmp6, incount);
+ Add (Str => tmp6);
+ Add (Str => ": input error");
+ Add (Ch => newl);
+ exit;
+ end if;
+ incount := incount + 1;
+ end loop;
+ end loop;
+
+ End_Mouse (tmp2);
+ Set_Timeout_Mode (Mode => Blocking, Amount => 0); -- amount is ignored
+ Set_Raw_Mode (SwitchOn => False);
+ Set_NL_Mode (SwitchOn => True);
+ Erase;
+ End_Windows;
+end ncurses2.getch_test;
diff --git a/Ada95/samples/ncurses2-getch_test.ads b/Ada95/samples/ncurses2-getch_test.ads
new file mode 100644
index 0000000..78a0a48
--- /dev/null
+++ b/Ada95/samples/ncurses2-getch_test.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+procedure ncurses2.getch_test;
diff --git a/Ada95/samples/ncurses2-getopt.adb b/Ada95/samples/ncurses2-getopt.adb
new file mode 100644
index 0000000..238c439
--- /dev/null
+++ b/Ada95/samples/ncurses2-getopt.adb
@@ -0,0 +1,163 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-2004,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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.7 $
+-- $Date: 2008/07/26 18:46:44 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+-- A simplified version of the GNU getopt function
+-- copyright Free Software Foundtion
+
+with Ada.Strings.Fixed;
+with Ada.Strings.Bounded;
+with Ada.Text_IO; use Ada.Text_IO;
+
+package body ncurses2.getopt is
+
+ nextchar : Natural := 0;
+
+ -- Ncurses doesn't use the non option elements so we are spared
+ -- the job of computing those.
+
+ -- also the user is not allowed to modify argv or argc
+ -- Doing so is Erroneous execution.
+
+ -- longoptions are not handled.
+
+ procedure Qgetopt (retval : out Integer;
+ argc : Integer;
+ argv : stringfunc;
+ -- argv will be the Argument function.
+ optstring : String;
+ optind : in out Integer;
+ -- ignored for ncurses, must be initialized to 1 by
+ -- the caller
+ Optarg : out stringa
+ -- a garbage colector would be useful here.
+ ) is
+
+ package BS is new Ada.Strings.Bounded.Generic_Bounded_Length (200);
+ use BS;
+ optargx : Bounded_String;
+ begin
+
+ if argc < optind then
+ retval := -1;
+ return;
+ end if;
+
+ optargx := To_Bounded_String ("");
+
+ if nextchar = 0 then
+
+ if argv (optind) = "--" then
+ -- the rest are non-options, we ignore them
+ retval := -1;
+ return;
+ end if;
+
+ if argv (optind)(1) /= '-' or argv (optind)'Length = 1 then
+ optind := optind + 1;
+ Optarg := new String'(argv (optind));
+ retval := 1;
+ return;
+ end if;
+
+ nextchar := 2; -- skip the one hyphen.
+ end if;
+
+ -- Look at and handle the next short option-character.
+ declare
+ c : Character := argv (optind) (nextchar);
+ temp : constant Natural :=
+ Ada.Strings.Fixed.Index (optstring, String'(1 => c));
+ begin
+ if temp = 0 or c = ':' then
+ Put_Line (Standard_Error,
+ argv (optind) & ": invalid option -- " & c);
+ c := '?';
+ return;
+ end if;
+
+ if optstring (temp + 1) = ':' then
+ if optstring (temp + 2) = ':' then
+ -- This is an option that accepts an argument optionally.
+ if nextchar /= argv (optind)'Length then
+ optargx := To_Bounded_String
+ (argv (optind) (nextchar .. argv (optind)'Length));
+ else
+ Optarg := null;
+ end if;
+ else
+ -- This is an option that requires an argument.
+ if nextchar /= argv (optind)'Length then
+ optargx := To_Bounded_String
+ (argv (optind) (nextchar .. argv (optind)'Length));
+ optind := optind + 1;
+ elsif optind = argc then
+ Put_Line (Standard_Error,
+ argv (optind) &
+ ": option requires an argument -- " & c);
+ if optstring (optstring'First) = ':' then
+ c := ':';
+ else
+ c := '?';
+ end if;
+ else
+ -- increment it again when taking next ARGV-elt as argument.
+ optind := optind + 1;
+ optargx := To_Bounded_String (argv (optind));
+ optind := optind + 1;
+ end if;
+ end if;
+ nextchar := 0;
+ else -- no argument for the option
+ if nextchar = argv (optind)'Length then
+ optind := optind + 1;
+ nextchar := 0;
+ else
+ nextchar := nextchar + 1;
+ end if;
+ end if;
+
+ retval := Character'Pos (c);
+ Optarg := new String'(To_String (optargx));
+ return;
+ end;
+ end Qgetopt;
+
+end ncurses2.getopt;
diff --git a/Ada95/samples/ncurses2-getopt.ads b/Ada95/samples/ncurses2-getopt.ads
new file mode 100644
index 0000000..a8b356e
--- /dev/null
+++ b/Ada95/samples/ncurses2-getopt.ads
@@ -0,0 +1,60 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000,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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.2 $
+-- $Date: 2006/06/25 14:24:40 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package ncurses2.getopt is
+
+ type stringa is access String;
+
+ type stringfunc is access
+ function (n : Positive) return String;
+
+ procedure Qgetopt (retval : out Integer;
+ argc : Integer;
+ argv : stringfunc;
+ optstring : String;
+ optind : in out Integer;
+ -- ignored for ncurses, must be initialized to 0
+ -- by the caller
+ Optarg : out stringa
+ -- a garbage collector would be useful here.
+ );
+
+end ncurses2.getopt;
diff --git a/Ada95/samples/ncurses2-m.adb b/Ada95/samples/ncurses2-m.adb
new file mode 100644
index 0000000..5b20428
--- /dev/null
+++ b/Ada95/samples/ncurses2-m.adb
@@ -0,0 +1,448 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.8 $
+-- $Date: 2008/07/26 18:47:50 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+-- TODO use Default_Character where appropriate
+
+-- This is an Ada version of ncurses
+-- I translated this because it tests the most features.
+
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Trace; use Terminal_Interface.Curses.Trace;
+
+with Ada.Text_IO; use Ada.Text_IO;
+
+with Ada.Characters.Latin_1;
+-- with Ada.Characters.Handling;
+
+with Ada.Command_Line; use Ada.Command_Line;
+
+with Ada.Strings.Unbounded;
+
+with ncurses2.util; use ncurses2.util;
+with ncurses2.getch_test;
+with ncurses2.attr_test;
+with ncurses2.color_test;
+with ncurses2.demo_panels;
+with ncurses2.color_edit;
+with ncurses2.slk_test;
+with ncurses2.acs_display;
+with ncurses2.acs_and_scroll;
+with ncurses2.flushinp_test;
+with ncurses2.test_sgr_attributes;
+with ncurses2.menu_test;
+with ncurses2.demo_pad;
+with ncurses2.demo_forms;
+with ncurses2.overlap_test;
+with ncurses2.trace_set;
+
+with ncurses2.getopt; use ncurses2.getopt;
+
+package body ncurses2.m is
+ use Int_IO;
+
+ function To_trace (n : Integer) return Trace_Attribute_Set;
+ procedure usage;
+ procedure Set_Terminal_Modes;
+ function Do_Single_Test (c : Character) return Boolean;
+
+ function To_trace (n : Integer) return Trace_Attribute_Set is
+ a : Trace_Attribute_Set := (others => False);
+ m : Integer;
+ rest : Integer;
+ begin
+ m := n mod 2;
+ if 1 = m then
+ a.Times := True;
+ end if;
+ rest := n / 2;
+
+ m := rest mod 2;
+ if 1 = m then
+ a.Tputs := True;
+ end if;
+ rest := rest / 2;
+ m := rest mod 2;
+ if 1 = m then
+ a.Update := True;
+ end if;
+ rest := rest / 2;
+ m := rest mod 2;
+ if 1 = m then
+ a.Cursor_Move := True;
+ end if;
+ rest := rest / 2;
+ m := rest mod 2;
+ if 1 = m then
+ a.Character_Output := True;
+ end if;
+ rest := rest / 2;
+ m := rest mod 2;
+ if 1 = m then
+ a.Calls := True;
+ end if;
+ rest := rest / 2;
+ m := rest mod 2;
+ if 1 = m then
+ a.Virtual_Puts := True;
+ end if;
+ rest := rest / 2;
+ m := rest mod 2;
+ if 1 = m then
+ a.Input_Events := True;
+ end if;
+ rest := rest / 2;
+ m := rest mod 2;
+ if 1 = m then
+ a.TTY_State := True;
+ end if;
+ rest := rest / 2;
+ m := rest mod 2;
+ if 1 = m then
+ a.Internal_Calls := True;
+ end if;
+ rest := rest / 2;
+ m := rest mod 2;
+ if 1 = m then
+ a.Character_Calls := True;
+ end if;
+ rest := rest / 2;
+ m := rest mod 2;
+ if 1 = m then
+ a.Termcap_TermInfo := True;
+ end if;
+
+ return a;
+ end To_trace;
+
+ -- these are type Stdscr_Init_Proc;
+
+ function rip_footer (
+ Win : Window;
+ Columns : Column_Count) return Integer;
+ pragma Convention (C, rip_footer);
+
+ function rip_footer (
+ Win : Window;
+ Columns : Column_Count) return Integer is
+ begin
+ Set_Background (Win, (Ch => ' ',
+ Attr => (Reverse_Video => True, others => False),
+ Color => 0));
+ Erase (Win);
+ Move_Cursor (Win, 0, 0);
+ Add (Win, "footer:" & Columns'Img & " columns");
+ Refresh_Without_Update (Win);
+ return 0; -- Curses_OK;
+ end rip_footer;
+
+ function rip_header (
+ Win : Window;
+ Columns : Column_Count) return Integer;
+ pragma Convention (C, rip_header);
+
+ function rip_header (
+ Win : Window;
+ Columns : Column_Count) return Integer is
+ begin
+ Set_Background (Win, (Ch => ' ',
+ Attr => (Reverse_Video => True, others => False),
+ Color => 0));
+ Erase (Win);
+ Move_Cursor (Win, 0, 0);
+ Add (Win, "header:" & Columns'Img & " columns");
+ -- 'Img is a GNAT extention
+ Refresh_Without_Update (Win);
+ return 0; -- Curses_OK;
+ end rip_header;
+
+ procedure usage is
+ -- type Stringa is access String;
+ use Ada.Strings.Unbounded;
+ -- tbl : constant array (Positive range <>) of Stringa := (
+ tbl : constant array (Positive range <>) of Unbounded_String
+ := (
+ To_Unbounded_String ("Usage: ncurses [options]"),
+ To_Unbounded_String (""),
+ To_Unbounded_String ("Options:"),
+ To_Unbounded_String (" -a f,b set default-colors " &
+ "(assumed white-on-black)"),
+ To_Unbounded_String (" -d use default-colors if terminal " &
+ "supports them"),
+ To_Unbounded_String (" -e fmt specify format for soft-keys " &
+ "test (e)"),
+ To_Unbounded_String (" -f rip-off footer line " &
+ "(can repeat)"),
+ To_Unbounded_String (" -h rip-off header line " &
+ "(can repeat)"),
+ To_Unbounded_String (" -s msec specify nominal time for " &
+ "panel-demo (default: 1, to hold)"),
+ To_Unbounded_String (" -t mask specify default trace-level " &
+ "(may toggle with ^T)")
+ );
+ begin
+ for n in tbl'Range loop
+ Put_Line (Standard_Error, To_String (tbl (n)));
+ end loop;
+ -- exit(EXIT_FAILURE);
+ -- TODO should we use Set_Exit_Status and throw and exception?
+ end usage;
+
+ procedure Set_Terminal_Modes is begin
+ Set_Raw_Mode (SwitchOn => False);
+ Set_Cbreak_Mode (SwitchOn => True);
+ Set_Echo_Mode (SwitchOn => False);
+ Allow_Scrolling (Mode => True);
+ Use_Insert_Delete_Line (Do_Idl => True);
+ Set_KeyPad_Mode (SwitchOn => True);
+ end Set_Terminal_Modes;
+
+ nap_msec : Integer := 1;
+
+ function Do_Single_Test (c : Character) return Boolean is
+ begin
+ case c is
+ when 'a' =>
+ getch_test;
+ when 'b' =>
+ attr_test;
+ when 'c' =>
+ if not Has_Colors then
+ Cannot ("does not support color.");
+ else
+ color_test;
+ end if;
+ when 'd' =>
+ if not Has_Colors then
+ Cannot ("does not support color.");
+ elsif not Can_Change_Color then
+ Cannot ("has hardwired color values.");
+ else
+ color_edit;
+ end if;
+ when 'e' =>
+ slk_test;
+ when 'f' =>
+ acs_display;
+ when 'o' =>
+ demo_panels (nap_msec);
+ when 'g' =>
+ acs_and_scroll;
+ when 'i' =>
+ flushinp_test (Standard_Window);
+ when 'k' =>
+ test_sgr_attributes;
+ when 'm' =>
+ menu_test;
+ when 'p' =>
+ demo_pad;
+ when 'r' =>
+ demo_forms;
+ when 's' =>
+ overlap_test;
+ when 't' =>
+ trace_set;
+ when '?' =>
+ null;
+ when others => return False;
+ end case;
+ return True;
+ end Do_Single_Test;
+
+ command : Character;
+ my_e_param : Soft_Label_Key_Format := Four_Four;
+ assumed_colors : Boolean := False;
+ default_colors : Boolean := False;
+ default_fg : Color_Number := White;
+ default_bg : Color_Number := Black;
+ -- nap_msec was an unsigned long integer in the C version,
+ -- yet napms only takes an int!
+
+ c : Integer;
+ c2 : Character;
+ optind : Integer := 1; -- must be initialized to one.
+ optarg : getopt.stringa;
+
+ length : Integer;
+ tmpi : Integer;
+
+ package myio is new Ada.Text_IO.Integer_IO (Integer);
+ use myio;
+
+ save_trace : Integer := 0;
+ save_trace_set : Trace_Attribute_Set;
+
+ function main return Integer is
+ begin
+ loop
+ Qgetopt (c, Argument_Count, Argument'Access,
+ "a:de:fhs:t:", optind, optarg);
+ exit when c = -1;
+ c2 := Character'Val (c);
+ case c2 is
+ when 'a' =>
+ -- Ada doesn't have scanf, it doesn't even have a
+ -- regular expression library.
+ assumed_colors := True;
+ myio.Get (optarg.all, Integer (default_fg), length);
+ myio.Get (optarg.all (length + 2 .. optarg.all'Length),
+ Integer (default_bg), length);
+ when 'd' =>
+ default_colors := True;
+ when 'e' =>
+ myio.Get (optarg.all, tmpi, length);
+ if tmpi > 3 then
+ usage;
+ return 1;
+ end if;
+ my_e_param := Soft_Label_Key_Format'Val (tmpi);
+ when 'f' =>
+ Rip_Off_Lines (-1, rip_footer'Access);
+ when 'h' =>
+ Rip_Off_Lines (1, rip_header'Access);
+ when 's' =>
+ myio.Get (optarg.all, nap_msec, length);
+ when 't' =>
+ myio.Get (optarg.all, save_trace, length);
+ when others =>
+ usage;
+ return 1;
+ end case;
+ end loop;
+
+ -- the C version had a bunch of macros here.
+
+ -- if (!isatty(fileno(stdin)))
+ -- isatty is not available in the standard Ada so skip it.
+ save_trace_set := To_trace (save_trace);
+ Trace_On (save_trace_set);
+
+ Init_Soft_Label_Keys (my_e_param);
+
+ Init_Screen;
+ Set_Background (Ch => (Ch => Blank,
+ Attr => Normal_Video,
+ Color => Color_Pair'First));
+
+ if Has_Colors then
+ Start_Color;
+ if default_colors then
+ Use_Default_Colors;
+ elsif assumed_colors then
+ Assume_Default_Colors (default_fg, default_bg);
+ end if;
+ end if;
+
+ Set_Terminal_Modes;
+ Save_Curses_Mode (Curses);
+
+ End_Windows;
+
+ -- TODO add macro #if blocks.
+ Put_Line ("Welcome to " & Curses_Version & ". Press ? for help.");
+
+ loop
+ Put_Line ("This is the ncurses main menu");
+ Put_Line ("a = keyboard and mouse input test");
+ Put_Line ("b = character attribute test");
+ Put_Line ("c = color test pattern");
+ Put_Line ("d = edit RGB color values");
+ Put_Line ("e = exercise soft keys");
+ Put_Line ("f = display ACS characters");
+ Put_Line ("g = display windows and scrolling");
+ Put_Line ("i = test of flushinp()");
+ Put_Line ("k = display character attributes");
+ Put_Line ("m = menu code test");
+ Put_Line ("o = exercise panels library");
+ Put_Line ("p = exercise pad features");
+ Put_Line ("q = quit");
+ Put_Line ("r = exercise forms code");
+ Put_Line ("s = overlapping-refresh test");
+ Put_Line ("t = set trace level");
+ Put_Line ("? = repeat this command summary");
+
+ Put ("> ");
+ Flush;
+
+ command := Ada.Characters.Latin_1.NUL;
+ -- get_input:
+ -- loop
+ declare
+ Ch : Character;
+ begin
+ Get (Ch);
+ -- TODO if read(ch) <= 0
+ -- TODO ada doesn't have an Is_Space function
+ command := Ch;
+ -- TODO if ch = '\n' or '\r' are these in Ada?
+ end;
+ -- end loop get_input;
+
+ declare
+ begin
+ if Do_Single_Test (command) then
+ Flush_Input;
+ Set_Terminal_Modes;
+ Reset_Curses_Mode (Curses);
+ Clear;
+ Refresh;
+ End_Windows;
+ if command = '?' then
+ Put_Line ("This is the ncurses capability tester.");
+ Put_Line ("You may select a test from the main menu by " &
+ "typing the");
+ Put_Line ("key letter of the choice (the letter to left " &
+ "of the =)");
+ Put_Line ("at the > prompt. The commands `x' or `q' will " &
+ "exit.");
+ end if;
+ -- continue; --why continue in the C version?
+ end if;
+ exception
+ when Curses_Exception => End_Windows;
+ end;
+
+ exit when command = 'q';
+ end loop;
+ Curses_Free_All;
+ return 0; -- TODO ExitProgram(EXIT_SUCCESS);
+ end main;
+
+end ncurses2.m;
diff --git a/Ada95/samples/ncurses2-m.ads b/Ada95/samples/ncurses2-m.ads
new file mode 100644
index 0000000..c32d895
--- /dev/null
+++ b/Ada95/samples/ncurses2-m.ads
@@ -0,0 +1,43 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package ncurses2.m is
+ function main return Integer;
+end ncurses2.m;
diff --git a/Ada95/samples/ncurses2-menu_test.adb b/Ada95/samples/ncurses2-menu_test.adb
new file mode 100644
index 0000000..a4c4807
--- /dev/null
+++ b/Ada95/samples/ncurses2-menu_test.adb
@@ -0,0 +1,168 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-2004,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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.6 $
+-- $Date: 2006/06/25 14:24:40 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with ncurses2.util; use ncurses2.util;
+
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus;
+with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
+
+procedure ncurses2.menu_test is
+ function menu_virtualize (c : Key_Code) return Menu_Request_Code;
+ procedure xAdd (l : Line_Position; c : Column_Position; s : String);
+
+ function menu_virtualize (c : Key_Code) return Menu_Request_Code is
+ begin
+ case c is
+ when Character'Pos (newl) | Key_Exit =>
+ return Menu_Request_Code'Last + 1; -- MAX_COMMAND? TODO
+ when Character'Pos ('u') =>
+ return M_ScrollUp_Line;
+ when Character'Pos ('d') =>
+ return M_ScrollDown_Line;
+ when Character'Pos ('b') | Key_Next_Page =>
+ return M_ScrollUp_Page;
+ when Character'Pos ('f') | Key_Previous_Page =>
+ return M_ScrollDown_Page;
+ when Character'Pos ('n') | Key_Cursor_Down =>
+ return M_Next_Item;
+ when Character'Pos ('p') | Key_Cursor_Up =>
+ return M_Previous_Item;
+ when Character'Pos (' ') =>
+ return M_Toggle_Item;
+ when Key_Mouse =>
+ return c;
+ when others =>
+ Beep;
+ return c;
+ end case;
+ end menu_virtualize;
+
+ MENU_Y : constant Line_Count := 8;
+ MENU_X : constant Column_Count := 8;
+
+ type String_Access is access String;
+
+ animals : constant array (Positive range <>) of String_Access :=
+ (new String'("Lions"),
+ new String'("Tigers"),
+ new String'("Bears"),
+ new String'("(Oh my!)"),
+ new String'("Newts"),
+ new String'("Platypi"),
+ new String'("Lemurs"));
+
+ items_a : constant Item_Array_Access :=
+ new Item_Array (1 .. animals'Last + 1);
+
+ tmp : Event_Mask;
+
+ procedure xAdd (l : Line_Position; c : Column_Position; s : String) is
+ begin
+ Add (Line => l, Column => c, Str => s);
+ end xAdd;
+
+ mrows : Line_Count;
+ mcols : Column_Count;
+
+ menuwin : Window;
+
+ m : Menu;
+
+ c1 : Key_Code;
+
+ c : Driver_Result;
+ r : Menu_Request_Code;
+begin
+ tmp := Start_Mouse;
+ xAdd (0, 0, "This is the menu test:");
+ xAdd (2, 0, " Use up and down arrow to move the select bar.");
+ xAdd (3, 0, " 'n' and 'p' act like arrows.");
+ xAdd (4, 0, " 'b' and 'f' scroll up/down (page), 'u' and 'd' (line).");
+ xAdd (5, 0, " Press return to exit.");
+ Refresh;
+
+ for i in animals'Range loop
+ items_a (i) := New_Item (animals (i).all);
+ end loop;
+ items_a (animals'Last + 1) := Null_Item;
+
+ m := New_Menu (items_a);
+
+ Set_Format (m, Line_Position (animals'Last + 1) / 2, 1);
+ Scale (m, mrows, mcols);
+
+ menuwin := Create (mrows + 2, mcols + 2, MENU_Y, MENU_X);
+ Set_Window (m, menuwin);
+ Set_KeyPad_Mode (menuwin, True);
+ Box (menuwin); -- 0,0?
+
+ Set_Sub_Window (m, Derived_Window (menuwin, mrows, mcols, 1, 1));
+
+ Post (m);
+
+ loop
+ c1 := Getchar (menuwin);
+ r := menu_virtualize (c1);
+ c := Driver (m, r);
+ exit when c = Unknown_Request; -- E_UNKNOWN_COMMAND?
+ if c = Request_Denied then
+ Beep;
+ end if;
+ -- continue ?
+ end loop;
+
+ Move_Cursor (Line => Lines - 2, Column => 0);
+ Add (Str => "You chose: ");
+ Add (Str => Name (Current (m)));
+ Add (Ch => newl);
+ Pause; -- the C version didn't use Pause, it spelled it out
+
+ Post (m, False); -- unpost, not clear :-(
+ declare begin
+ Delete (menuwin);
+ exception when Curses_Exception => null; end;
+ -- menuwin has children so will raise the exception.
+
+ Delete (m);
+
+ End_Mouse (tmp);
+end ncurses2.menu_test;
diff --git a/Ada95/samples/ncurses2-menu_test.ads b/Ada95/samples/ncurses2-menu_test.ads
new file mode 100644
index 0000000..17e5b16
--- /dev/null
+++ b/Ada95/samples/ncurses2-menu_test.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+procedure ncurses2.menu_test;
diff --git a/Ada95/samples/ncurses2-overlap_test.adb b/Ada95/samples/ncurses2-overlap_test.adb
new file mode 100644
index 0000000..37e8d4c
--- /dev/null
+++ b/Ada95/samples/ncurses2-overlap_test.adb
@@ -0,0 +1,157 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000,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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.4 $
+-- $Date: 2004/08/21 21:37:00 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with ncurses2.util; use ncurses2.util;
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+
+-- test effects of overlapping windows
+
+procedure ncurses2.overlap_test is
+
+ procedure fillwin (win : Window; ch : Character);
+ procedure crosswin (win : Window; ch : Character);
+
+ procedure fillwin (win : Window; ch : Character) is
+ y1 : Line_Position;
+ x1 : Column_Position;
+ begin
+ Get_Size (win, y1, x1);
+ for y in 0 .. y1 - 1 loop
+ Move_Cursor (win, y, 0);
+ for x in 0 .. x1 - 1 loop
+ Add (win, Ch => ch);
+ end loop;
+ end loop;
+ exception
+ when Curses_Exception => null;
+ -- write to lower right corner
+ end fillwin;
+
+ procedure crosswin (win : Window; ch : Character) is
+ y1 : Line_Position;
+ x1 : Column_Position;
+ begin
+ Get_Size (win, y1, x1);
+ for y in 0 .. y1 - 1 loop
+ for x in 0 .. x1 - 1 loop
+ if ((x > (x1 - 1) / 3) and (x <= (2 * (x1 - 1)) / 3))
+ or (((y > (y1 - 1) / 3) and (y <= (2 * (y1 - 1)) / 3))) then
+ Move_Cursor (win, y, x);
+ Add (win, Ch => ch);
+ end if;
+ end loop;
+ end loop;
+ end crosswin;
+
+ -- In a 24x80 screen like some xterms are, the instructions will
+ -- be overwritten.
+ ch : Character;
+ win1 : Window := New_Window (9, 20, 3, 3);
+ win2 : Window := New_Window (9, 20, 9, 16);
+begin
+ Set_Raw_Mode (SwitchOn => True);
+ Refresh;
+ Move_Cursor (Line => 0, Column => 0);
+ Add (Str => "This test shows the behavior of wnoutrefresh() with " &
+ "respect to");
+ Add (Ch => newl);
+ Add (Str => "the shared region of two overlapping windows A and B. "&
+ "The cross");
+ Add (Ch => newl);
+ Add (Str => "pattern in each window does not overlap the other.");
+ Add (Ch => newl);
+
+ Move_Cursor (Line => 18, Column => 0);
+ Add (Str => "a = refresh A, then B, then doupdate. b = refresh B, " &
+ "then A, then doupdaute");
+ Add (Ch => newl);
+ Add (Str => "c = fill window A with letter A. d = fill window B " &
+ "with letter B.");
+ Add (Ch => newl);
+ Add (Str => "e = cross pattern in window A. f = cross pattern " &
+ "in window B.");
+ Add (Ch => newl);
+ Add (Str => "g = clear window A. h = clear window B.");
+ Add (Ch => newl);
+ Add (Str => "i = overwrite A onto B. j = overwrite " &
+ "B onto A.");
+ Add (Ch => newl);
+ Add (Str => "^Q/ESC = terminate test.");
+
+ loop
+ ch := Code_To_Char (Getchar);
+ exit when ch = CTRL ('Q') or ch = CTRL ('['); -- QUIT or ESCAPE
+ case ch is
+ when 'a' => -- refresh window A first, then B
+ Refresh_Without_Update (win1);
+ Refresh_Without_Update (win2);
+ Update_Screen;
+ when 'b' => -- refresh window B first, then A
+ Refresh_Without_Update (win2);
+ Refresh_Without_Update (win1);
+ Update_Screen;
+ when 'c' => -- fill window A so it's visible
+ fillwin (win1, 'A');
+ when 'd' => -- fill window B so it's visible
+ fillwin (win2, 'B');
+ when 'e' => -- cross test pattern in window A
+ crosswin (win1, 'A');
+ when 'f' => -- cross test pattern in window B
+ crosswin (win2, 'B');
+ when 'g' => -- clear window A
+ Clear (win1);
+ Move_Cursor (win1, 0, 0);
+ when 'h' => -- clear window B
+ Clear (win2);
+ Move_Cursor (win2, 0, 0);
+ when 'i' => -- overwrite A onto B
+ Overwrite (win1, win2);
+ when 'j' => -- overwrite B onto A
+ Overwrite (win2, win1);
+ when others => null;
+ end case;
+ end loop;
+
+ Delete (win2);
+ Delete (win1);
+ Erase;
+ End_Windows;
+end ncurses2.overlap_test;
diff --git a/Ada95/samples/ncurses2-overlap_test.ads b/Ada95/samples/ncurses2-overlap_test.ads
new file mode 100644
index 0000000..ce6e3e6
--- /dev/null
+++ b/Ada95/samples/ncurses2-overlap_test.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+procedure ncurses2.overlap_test;
diff --git a/Ada95/samples/ncurses2-slk_test.adb b/Ada95/samples/ncurses2-slk_test.adb
new file mode 100644
index 0000000..8bfee4e
--- /dev/null
+++ b/Ada95/samples/ncurses2-slk_test.adb
@@ -0,0 +1,174 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-2004,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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.7 $
+-- $Date: 2006/06/25 14:24:40 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with ncurses2.util; use ncurses2.util;
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+
+with Ada.Strings.Unbounded;
+with Interfaces.C;
+with Terminal_Interface.Curses.Aux;
+
+procedure ncurses2.slk_test is
+ procedure myGet (Win : in Window := Standard_Window;
+ Str : out Ada.Strings.Unbounded.Unbounded_String;
+ Len : in Integer := -1);
+
+ procedure myGet (Win : in Window := Standard_Window;
+ Str : out Ada.Strings.Unbounded.Unbounded_String;
+ Len : in Integer := -1)
+ is
+ use Ada.Strings.Unbounded;
+ use Interfaces.C;
+ use Terminal_Interface.Curses.Aux;
+
+ function Wgetnstr (Win : Window;
+ Str : char_array;
+ Len : int) return int;
+ pragma Import (C, Wgetnstr, "wgetnstr");
+
+ -- FIXME: how to construct "(Len > 0) ? Len : 80"?
+ Ask : constant Interfaces.C.size_t := Interfaces.C.size_t'Val (Len + 80);
+ Txt : char_array (0 .. Ask);
+
+ begin
+ Txt (0) := Interfaces.C.char'First;
+ if Wgetnstr (Win, Txt, Txt'Length) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ Str := To_Unbounded_String (To_Ada (Txt, True));
+ end myGet;
+
+ use Int_IO;
+
+ use Ada.Strings.Unbounded;
+
+ c : Key_Code;
+ buf : Unbounded_String;
+ c2 : Character;
+ fmt : Label_Justification := Centered;
+ tmp : Integer;
+
+begin
+ c := CTRL ('l');
+ loop
+ Move_Cursor (Line => 0, Column => 0);
+ c2 := Code_To_Char (c);
+ case c2 is
+ when Character'Val (Character'Pos ('l') mod 16#20#) => -- CTRL('l')
+ Erase;
+ Switch_Character_Attribute (Attr => (Bold_Character => True,
+ others => False));
+ Add (Line => 0, Column => 20,
+ Str => "Soft Key Exerciser");
+ Switch_Character_Attribute (On => False,
+ Attr => (Bold_Character => True,
+ others => False));
+
+ Move_Cursor (Line => 2, Column => 0);
+ P ("Available commands are:");
+ P ("");
+ P ("^L -- refresh screen");
+ P ("a -- activate or restore soft keys");
+ P ("d -- disable soft keys");
+ P ("c -- set centered format for labels");
+ P ("l -- set left-justified format for labels");
+ P ("r -- set right-justified format for labels");
+ P ("[12345678] -- set label; labels are numbered 1 through 8");
+ P ("e -- erase stdscr (should not erase labels)");
+ P ("s -- test scrolling of shortened screen");
+ P ("x, q -- return to main menu");
+ P ("");
+ P ("Note: if activating the soft keys causes your terminal to");
+ P ("scroll up one line, your terminal auto-scrolls when anything");
+ P ("is written to the last screen position. The ncurses code");
+ P ("does not yet handle this gracefully.");
+ Refresh;
+ Restore_Soft_Label_Keys;
+
+ when 'a' =>
+ Restore_Soft_Label_Keys;
+ when 'e' =>
+ Clear;
+ when 's' =>
+ Add (Line => 20, Column => 0,
+ Str => "Press Q to stop the scrolling-test: ");
+ loop
+ c := Getchar;
+ c2 := Code_To_Char (c);
+ exit when c2 = 'Q';
+ -- c = ERR?
+ -- TODO when c is not a character (arrow key)
+ -- the behavior is different from the C version.
+ Add (Ch => c2);
+ end loop;
+ when 'd' =>
+ Clear_Soft_Label_Keys;
+ when 'l' =>
+ fmt := Left;
+ when 'c' =>
+ fmt := Centered;
+ when 'r' =>
+ fmt := Right;
+ when '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' =>
+ Add (Line => 20, Column => 0,
+ Str => "Please enter the label value: ");
+ Set_Echo_Mode (SwitchOn => True);
+ myGet (Str => buf);
+ Set_Echo_Mode (SwitchOn => False);
+ tmp := ctoi (c2);
+ Set_Soft_Label_Key (Label_Number (tmp), To_String (buf), fmt);
+ Refresh_Soft_Label_Keys;
+ Move_Cursor (Line => 20, Column => 0);
+ Clear_To_End_Of_Line;
+ when 'x' | 'q' =>
+ exit;
+ -- the C version needed a goto, ha ha
+ -- breaks exit the case not the loop because fall-throuh
+ -- happens in C!
+ when others =>
+ Beep;
+ end case;
+ c := Getchar;
+ -- TODO exit when c = EOF
+ end loop;
+ Erase;
+ End_Windows;
+end ncurses2.slk_test;
diff --git a/Ada95/samples/ncurses2-slk_test.ads b/Ada95/samples/ncurses2-slk_test.ads
new file mode 100644
index 0000000..51e9587
--- /dev/null
+++ b/Ada95/samples/ncurses2-slk_test.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+procedure ncurses2.slk_test;
diff --git a/Ada95/samples/ncurses2-test_sgr_attributes.adb b/Ada95/samples/ncurses2-test_sgr_attributes.adb
new file mode 100644
index 0000000..97449a4
--- /dev/null
+++ b/Ada95/samples/ncurses2-test_sgr_attributes.adb
@@ -0,0 +1,185 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000,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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.2 $
+-- $Date: 2006/06/25 14:24:40 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with ncurses2.util; use ncurses2.util;
+
+-- Graphic-rendition test (adapted from vttest)
+
+procedure ncurses2.test_sgr_attributes is
+
+ procedure xAdd (l : Line_Position; c : Column_Position; s : String);
+
+ procedure xAdd (l : Line_Position; c : Column_Position; s : String) is
+ begin
+ Add (Line => l, Column => c, Str => s);
+ end xAdd;
+
+ normal, current : Attributed_Character;
+begin
+ for pass in reverse Boolean loop
+ if pass then
+ normal := (Ch => ' ', Attr => Normal_Video, Color => 0);
+ else
+ normal := (Ch => ' ', Attr =>
+ (Reverse_Video => True, others => False), Color => 0);
+ end if;
+
+ -- Use non-default colors if possible to exercise bce a little
+ if Has_Colors then
+ Init_Pair (1, White, Blue);
+ normal.Color := 1;
+ end if;
+ Set_Background (Ch => normal);
+ Erase;
+ xAdd (1, 20, "Graphic rendition test pattern:");
+
+ xAdd (4, 1, "vanilla");
+
+ current := normal;
+ current.Attr.Bold_Character := not current.Attr.Bold_Character;
+ Set_Background (Ch => current);
+ xAdd (4, 40, "bold");
+
+ current := normal;
+ current.Attr.Under_Line := not current.Attr.Under_Line;
+ Set_Background (Ch => current);
+ xAdd (6, 6, "underline");
+
+ current := normal;
+ current.Attr.Bold_Character := not current.Attr.Bold_Character;
+ current.Attr.Under_Line := not current.Attr.Under_Line;
+ Set_Background (Ch => current);
+ xAdd (6, 45, "bold underline");
+
+ current := normal;
+ current.Attr.Blink := not current.Attr.Blink;
+ Set_Background (Ch => current);
+ xAdd (8, 1, "blink");
+
+ current := normal;
+ current.Attr.Blink := not current.Attr.Blink;
+ current.Attr.Bold_Character := not current.Attr.Bold_Character;
+ Set_Background (Ch => current);
+ xAdd (8, 40, "bold blink");
+
+ current := normal;
+ current.Attr.Under_Line := not current.Attr.Under_Line;
+ current.Attr.Blink := not current.Attr.Blink;
+ Set_Background (Ch => current);
+ xAdd (10, 6, "underline blink");
+
+ current := normal;
+ current.Attr.Bold_Character := not current.Attr.Bold_Character;
+ current.Attr.Under_Line := not current.Attr.Under_Line;
+ current.Attr.Blink := not current.Attr.Blink;
+ Set_Background (Ch => current);
+ xAdd (10, 45, "bold underline blink");
+
+ current := normal;
+ current.Attr.Reverse_Video := not current.Attr.Reverse_Video;
+ Set_Background (Ch => current);
+ xAdd (12, 1, "negative");
+
+ current := normal;
+ current.Attr.Bold_Character := not current.Attr.Bold_Character;
+ current.Attr.Reverse_Video := not current.Attr.Reverse_Video;
+ Set_Background (Ch => current);
+ xAdd (12, 40, "bold negative");
+
+ current := normal;
+ current.Attr.Under_Line := not current.Attr.Under_Line;
+ current.Attr.Reverse_Video := not current.Attr.Reverse_Video;
+ Set_Background (Ch => current);
+ xAdd (14, 6, "underline negative");
+
+ current := normal;
+ current.Attr.Bold_Character := not current.Attr.Bold_Character;
+ current.Attr.Under_Line := not current.Attr.Under_Line;
+ current.Attr.Reverse_Video := not current.Attr.Reverse_Video;
+ Set_Background (Ch => current);
+ xAdd (14, 45, "bold underline negative");
+
+ current := normal;
+ current.Attr.Blink := not current.Attr.Blink;
+ current.Attr.Reverse_Video := not current.Attr.Reverse_Video;
+ Set_Background (Ch => current);
+ xAdd (16, 1, "blink negative");
+
+ current := normal;
+ current.Attr.Bold_Character := not current.Attr.Bold_Character;
+ current.Attr.Blink := not current.Attr.Blink;
+ current.Attr.Reverse_Video := not current.Attr.Reverse_Video;
+ Set_Background (Ch => current);
+ xAdd (16, 40, "bold blink negative");
+
+ current := normal;
+ current.Attr.Under_Line := not current.Attr.Under_Line;
+ current.Attr.Blink := not current.Attr.Blink;
+ current.Attr.Reverse_Video := not current.Attr.Reverse_Video;
+ Set_Background (Ch => current);
+ xAdd (18, 6, "underline blink negative");
+
+ current := normal;
+ current.Attr.Bold_Character := not current.Attr.Bold_Character;
+ current.Attr.Under_Line := not current.Attr.Under_Line;
+ current.Attr.Blink := not current.Attr.Blink;
+ current.Attr.Reverse_Video := not current.Attr.Reverse_Video;
+ Set_Background (Ch => current);
+ xAdd (18, 45, "bold underline blink negative");
+
+ Set_Background (Ch => normal);
+ Move_Cursor (Line => Lines - 2, Column => 1);
+ if pass then
+ Add (Str => "Dark");
+ else
+ Add (Str => "Light");
+ end if;
+ Add (Str => " background. ");
+ Clear_To_End_Of_Line;
+ Pause;
+ end loop;
+
+ Set_Background (Ch => Blank2);
+ Erase;
+ End_Windows;
+
+end ncurses2.test_sgr_attributes;
diff --git a/Ada95/samples/ncurses2-test_sgr_attributes.ads b/Ada95/samples/ncurses2-test_sgr_attributes.ads
new file mode 100644
index 0000000..2411180
--- /dev/null
+++ b/Ada95/samples/ncurses2-test_sgr_attributes.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+procedure ncurses2.test_sgr_attributes;
diff --git a/Ada95/samples/ncurses2-trace_set.adb b/Ada95/samples/ncurses2-trace_set.adb
new file mode 100644
index 0000000..1e2716e
--- /dev/null
+++ b/Ada95/samples/ncurses2-trace_set.adb
@@ -0,0 +1,480 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses2.trace_set --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.3 $
+-- $Date: 2008/07/26 18:46:18 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with ncurses2.util; use ncurses2.util;
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Trace; use Terminal_Interface.Curses.Trace;
+with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus;
+
+with Ada.Strings.Bounded;
+
+-- interactively set the trace level
+
+procedure ncurses2.trace_set is
+
+ function menu_virtualize (c : Key_Code) return Menu_Request_Code;
+ function subset (super, sub : Trace_Attribute_Set) return Boolean;
+ function trace_or (a, b : Trace_Attribute_Set) return Trace_Attribute_Set;
+ function trace_num (tlevel : Trace_Attribute_Set) return String;
+ function tracetrace (tlevel : Trace_Attribute_Set) return String;
+ function run_trace_menu (m : Menu; count : Integer) return Boolean;
+
+ function menu_virtualize (c : Key_Code) return Menu_Request_Code is
+ begin
+ case c is
+ when Character'Pos (newl) | Key_Exit =>
+ return Menu_Request_Code'Last + 1; -- MAX_COMMAND? TODO
+ when Character'Pos ('u') =>
+ return M_ScrollUp_Line;
+ when Character'Pos ('d') =>
+ return M_ScrollDown_Line;
+ when Character'Pos ('b') | Key_Next_Page =>
+ return M_ScrollUp_Page;
+ when Character'Pos ('f') | Key_Previous_Page =>
+ return M_ScrollDown_Page;
+ when Character'Pos ('n') | Key_Cursor_Down =>
+ return M_Next_Item;
+ when Character'Pos ('p') | Key_Cursor_Up =>
+ return M_Previous_Item;
+ when Character'Pos (' ') =>
+ return M_Toggle_Item;
+ when Key_Mouse =>
+ return c;
+ when others =>
+ Beep;
+ return c;
+ end case;
+ end menu_virtualize;
+
+ type string_a is access String;
+ type tbl_entry is record
+ name : string_a;
+ mask : Trace_Attribute_Set;
+ end record;
+
+ t_tbl : constant array (Positive range <>) of tbl_entry :=
+ (
+ (new String'("Disable"),
+ Trace_Disable),
+ (new String'("Times"),
+ Trace_Attribute_Set'(Times => True, others => False)),
+ (new String'("Tputs"),
+ Trace_Attribute_Set'(Tputs => True, others => False)),
+ (new String'("Update"),
+ Trace_Attribute_Set'(Update => True, others => False)),
+ (new String'("Cursor_Move"),
+ Trace_Attribute_Set'(Cursor_Move => True, others => False)),
+ (new String'("Character_Output"),
+ Trace_Attribute_Set'(Character_Output => True, others => False)),
+ (new String'("Ordinary"),
+ Trace_Ordinary),
+ (new String'("Calls"),
+ Trace_Attribute_Set'(Calls => True, others => False)),
+ (new String'("Virtual_Puts"),
+ Trace_Attribute_Set'(Virtual_Puts => True, others => False)),
+ (new String'("Input_Events"),
+ Trace_Attribute_Set'(Input_Events => True, others => False)),
+ (new String'("TTY_State"),
+ Trace_Attribute_Set'(TTY_State => True, others => False)),
+ (new String'("Internal_Calls"),
+ Trace_Attribute_Set'(Internal_Calls => True, others => False)),
+ (new String'("Character_Calls"),
+ Trace_Attribute_Set'(Character_Calls => True, others => False)),
+ (new String'("Termcap_TermInfo"),
+ Trace_Attribute_Set'(Termcap_TermInfo => True, others => False)),
+ (new String'("Maximium"),
+ Trace_Maximum)
+ );
+
+ package BS is new Ada.Strings.Bounded.Generic_Bounded_Length (300);
+
+ function subset (super, sub : Trace_Attribute_Set) return Boolean is
+ begin
+ if
+ (super.Times or not sub.Times) and
+ (super.Tputs or not sub.Tputs) and
+ (super.Update or not sub.Update) and
+ (super.Cursor_Move or not sub.Cursor_Move) and
+ (super.Character_Output or not sub.Character_Output) and
+ (super.Calls or not sub.Calls) and
+ (super.Virtual_Puts or not sub.Virtual_Puts) and
+ (super.Input_Events or not sub.Input_Events) and
+ (super.TTY_State or not sub.TTY_State) and
+ (super.Internal_Calls or not sub.Internal_Calls) and
+ (super.Character_Calls or not sub.Character_Calls) and
+ (super.Termcap_TermInfo or not sub.Termcap_TermInfo) and
+ True then
+ return True;
+ else
+ return False;
+ end if;
+ end subset;
+
+ function trace_or (a, b : Trace_Attribute_Set) return Trace_Attribute_Set is
+ retval : Trace_Attribute_Set := Trace_Disable;
+ begin
+ retval.Times := (a.Times or b.Times);
+ retval.Tputs := (a.Tputs or b.Tputs);
+ retval.Update := (a.Update or b.Update);
+ retval.Cursor_Move := (a.Cursor_Move or b.Cursor_Move);
+ retval.Character_Output := (a.Character_Output or b.Character_Output);
+ retval.Calls := (a.Calls or b.Calls);
+ retval.Virtual_Puts := (a.Virtual_Puts or b.Virtual_Puts);
+ retval.Input_Events := (a.Input_Events or b.Input_Events);
+ retval.TTY_State := (a.TTY_State or b.TTY_State);
+ retval.Internal_Calls := (a.Internal_Calls or b.Internal_Calls);
+ retval.Character_Calls := (a.Character_Calls or b.Character_Calls);
+ retval.Termcap_TermInfo := (a.Termcap_TermInfo or b.Termcap_TermInfo);
+
+ return retval;
+ end trace_or;
+
+ -- Print the hexadecimal value of the mask so
+ -- users can set it from the command line.
+
+ function trace_num (tlevel : Trace_Attribute_Set) return String is
+ result : Integer := 0;
+ m : Integer := 1;
+ begin
+
+ if tlevel.Times then
+ result := result + m;
+ end if;
+ m := m * 2;
+
+ if tlevel.Tputs then
+ result := result + m;
+ end if;
+ m := m * 2;
+
+ if tlevel.Update then
+ result := result + m;
+ end if;
+ m := m * 2;
+
+ if tlevel.Cursor_Move then
+ result := result + m;
+ end if;
+ m := m * 2;
+
+ if tlevel.Character_Output then
+ result := result + m;
+ end if;
+ m := m * 2;
+
+ if tlevel.Calls then
+ result := result + m;
+ end if;
+ m := m * 2;
+
+ if tlevel.Virtual_Puts then
+ result := result + m;
+ end if;
+ m := m * 2;
+
+ if tlevel.Input_Events then
+ result := result + m;
+ end if;
+ m := m * 2;
+
+ if tlevel.TTY_State then
+ result := result + m;
+ end if;
+ m := m * 2;
+
+ if tlevel.Internal_Calls then
+ result := result + m;
+ end if;
+ m := m * 2;
+
+ if tlevel.Character_Calls then
+ result := result + m;
+ end if;
+ m := m * 2;
+
+ if tlevel.Termcap_TermInfo then
+ result := result + m;
+ end if;
+ m := m * 2;
+ return result'Img;
+ end trace_num;
+
+ function tracetrace (tlevel : Trace_Attribute_Set) return String is
+
+ use BS;
+ buf : Bounded_String := To_Bounded_String ("");
+ begin
+ -- The C version prints the hexadecimal value of the mask, we
+ -- won't do that here because this is Ada.
+
+ if tlevel = Trace_Disable then
+ Append (buf, "Trace_Disable");
+ else
+
+ if subset (tlevel,
+ Trace_Attribute_Set'(Times => True, others => False)) then
+ Append (buf, "Times");
+ Append (buf, ", ");
+ end if;
+
+ if subset (tlevel,
+ Trace_Attribute_Set'(Tputs => True, others => False)) then
+ Append (buf, "Tputs");
+ Append (buf, ", ");
+ end if;
+
+ if subset (tlevel,
+ Trace_Attribute_Set'(Update => True, others => False)) then
+ Append (buf, "Update");
+ Append (buf, ", ");
+ end if;
+
+ if subset (tlevel,
+ Trace_Attribute_Set'(Cursor_Move => True,
+ others => False)) then
+ Append (buf, "Cursor_Move");
+ Append (buf, ", ");
+ end if;
+
+ if subset (tlevel,
+ Trace_Attribute_Set'(Character_Output => True,
+ others => False)) then
+ Append (buf, "Character_Output");
+ Append (buf, ", ");
+ end if;
+
+ if subset (tlevel,
+ Trace_Ordinary) then
+ Append (buf, "Ordinary");
+ Append (buf, ", ");
+ end if;
+
+ if subset (tlevel,
+ Trace_Attribute_Set'(Calls => True, others => False)) then
+ Append (buf, "Calls");
+ Append (buf, ", ");
+ end if;
+
+ if subset (tlevel,
+ Trace_Attribute_Set'(Virtual_Puts => True,
+ others => False)) then
+ Append (buf, "Virtual_Puts");
+ Append (buf, ", ");
+ end if;
+
+ if subset (tlevel,
+ Trace_Attribute_Set'(Input_Events => True,
+ others => False)) then
+ Append (buf, "Input_Events");
+ Append (buf, ", ");
+ end if;
+
+ if subset (tlevel,
+ Trace_Attribute_Set'(TTY_State => True,
+ others => False)) then
+ Append (buf, "TTY_State");
+ Append (buf, ", ");
+ end if;
+
+ if subset (tlevel,
+ Trace_Attribute_Set'(Internal_Calls => True,
+ others => False)) then
+ Append (buf, "Internal_Calls");
+ Append (buf, ", ");
+ end if;
+
+ if subset (tlevel,
+ Trace_Attribute_Set'(Character_Calls => True,
+ others => False)) then
+ Append (buf, "Character_Calls");
+ Append (buf, ", ");
+ end if;
+
+ if subset (tlevel,
+ Trace_Attribute_Set'(Termcap_TermInfo => True,
+ others => False)) then
+ Append (buf, "Termcap_TermInfo");
+ Append (buf, ", ");
+ end if;
+
+ if subset (tlevel,
+ Trace_Maximum) then
+ Append (buf, "Maximium");
+ Append (buf, ", ");
+ end if;
+ end if;
+
+ if To_String (buf) (Length (buf) - 1) = ',' then
+ Delete (buf, Length (buf) - 1, Length (buf));
+ end if;
+
+ return To_String (buf);
+ end tracetrace;
+
+ function run_trace_menu (m : Menu; count : Integer) return Boolean is
+ i, p : Item;
+ changed : Boolean;
+ c, v : Key_Code;
+ begin
+ loop
+ changed := (count /= 0);
+ c := Getchar (Get_Window (m));
+ v := menu_virtualize (c);
+ case Driver (m, v) is
+ when Unknown_Request =>
+ return False;
+ when others =>
+ i := Current (m);
+ if i = Menus.Items (m, 1) then -- the first item
+ for n in t_tbl'First + 1 .. t_tbl'Last loop
+ if Value (i) then
+ Set_Value (i, False);
+ changed := True;
+ end if;
+ end loop;
+ else
+ for n in t_tbl'First + 1 .. t_tbl'Last loop
+ p := Menus.Items (m, n);
+ if Value (p) then
+ Set_Value (Menus.Items (m, 1), False);
+ changed := True;
+ exit;
+ end if;
+ end loop;
+ end if;
+ if not changed then
+ return True;
+ end if;
+ end case;
+ end loop;
+ end run_trace_menu;
+
+ nc_tracing, mask : Trace_Attribute_Set;
+ pragma Import (C, nc_tracing, "_nc_tracing");
+ items_a : constant Item_Array_Access :=
+ new Item_Array (t_tbl'First .. t_tbl'Last + 1);
+ mrows : Line_Count;
+ mcols : Column_Count;
+ menuwin : Window;
+ menu_y : constant Line_Position := 8;
+ menu_x : constant Column_Position := 8;
+ ip : Item;
+ m : Menu;
+ count : Integer;
+ newtrace : Trace_Attribute_Set;
+begin
+ Add (Line => 0, Column => 0, Str => "Interactively set trace level:");
+ Add (Line => 2, Column => 0,
+ Str => " Press space bar to toggle a selection.");
+ Add (Line => 3, Column => 0,
+ Str => " Use up and down arrow to move the select bar.");
+ Add (Line => 4, Column => 0,
+ Str => " Press return to set the trace level.");
+ Add (Line => 6, Column => 0, Str => "(Current trace level is ");
+ Add (Str => tracetrace (nc_tracing) & " numerically: " &
+ trace_num (nc_tracing));
+ Add (Ch => ')');
+
+ Refresh;
+
+ for n in t_tbl'Range loop
+ items_a (n) := New_Item (t_tbl (n).name.all);
+ end loop;
+ items_a (t_tbl'Last + 1) := Null_Item;
+
+ m := New_Menu (items_a);
+
+ Set_Format (m, 16, 2);
+ Scale (m, mrows, mcols);
+
+ Switch_Options (m, (One_Valued => True, others => False), On => False);
+ menuwin := New_Window (mrows + 2, mcols + 2, menu_y, menu_x);
+ Set_Window (m, menuwin);
+ Set_KeyPad_Mode (menuwin, SwitchOn => True);
+ Box (menuwin);
+
+ Set_Sub_Window (m, Derived_Window (menuwin, mrows, mcols, 1, 1));
+
+ Post (m);
+
+ for n in t_tbl'Range loop
+ ip := Items (m, n);
+ mask := t_tbl (n).mask;
+ if mask = Trace_Disable then
+ Set_Value (ip, nc_tracing = Trace_Disable);
+ elsif subset (sub => mask, super => nc_tracing) then
+ Set_Value (ip, True);
+ end if;
+ end loop;
+
+ count := 1;
+ while run_trace_menu (m, count) loop
+ count := count + 1;
+ end loop;
+
+ newtrace := Trace_Disable;
+ for n in t_tbl'Range loop
+ ip := Items (m, n);
+ if Value (ip) then
+ mask := t_tbl (n).mask;
+ newtrace := trace_or (newtrace, mask);
+ end if;
+ end loop;
+
+ Trace_On (newtrace);
+ Trace_Put ("trace level interactively set to " &
+ tracetrace (nc_tracing));
+
+ Move_Cursor (Line => Lines - 4, Column => 0);
+ Add (Str => "Trace level is ");
+ Add (Str => tracetrace (nc_tracing));
+ Add (Ch => newl);
+ Pause; -- was just Add(); Getchar
+
+ Post (m, False);
+ -- menuwin has subwindows I think, which makes an error.
+ declare begin
+ Delete (menuwin);
+ exception when Curses_Exception => null; end;
+
+ -- free_menu(m);
+ -- free_item()
+end ncurses2.trace_set;
diff --git a/Ada95/samples/ncurses2-trace_set.ads b/Ada95/samples/ncurses2-trace_set.ads
new file mode 100644
index 0000000..7bbf8ca
--- /dev/null
+++ b/Ada95/samples/ncurses2-trace_set.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses2.trace_set --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+procedure ncurses2.trace_set;
diff --git a/Ada95/samples/ncurses2-util.adb b/Ada95/samples/ncurses2-util.adb
new file mode 100644
index 0000000..8ae3272
--- /dev/null
+++ b/Ada95/samples/ncurses2-util.adb
@@ -0,0 +1,190 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses2.util --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.7 $
+-- $Date: 2008/07/26 18:51:20 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Text_IO; use Ada.Text_IO;
+
+pragma Warnings (Off);
+with Terminal_Interface.Curses.Aux;
+pragma Warnings (On);
+
+with Terminal_Interface.Curses.Trace; use Terminal_Interface.Curses.Trace;
+
+with Interfaces.C;
+with Interfaces.C.Strings;
+
+with Ada.Characters.Handling;
+
+with ncurses2.genericPuts;
+
+package body ncurses2.util is
+
+ -- #defines from C
+ -- #define CTRL(x) ((x) & 0x1f)
+ function CTRL (c : Character) return Key_Code is
+ begin
+ return Character'Pos (c) mod 16#20#;
+ -- uses a property of ASCII
+ -- A = 16#41#; a = 16#61#; ^A = 1 or 16#1#
+ end CTRL;
+
+ function CTRL (c : Character) return Character is
+ begin
+ return Character'Val (Character'Pos (c) mod 16#20#);
+ -- uses a property of ASCII
+ -- A = 16#41#; a = 16#61#; ^A = 1 or 16#1#
+ end CTRL;
+
+ save_trace : Trace_Attribute_Set;
+ -- Common function to allow ^T to toggle trace-mode in the middle of a test
+ -- so that trace-files can be made smaller.
+ function Getchar (win : Window := Standard_Window) return Key_Code is
+ c : Key_Code;
+ begin
+ -- #ifdef TRACE
+ c := Get_Keystroke (win);
+ while c = CTRL ('T') loop
+ -- if _nc_tracing in C
+ if Current_Trace_Setting /= Trace_Disable then
+ save_trace := Current_Trace_Setting;
+ Trace_Put ("TOGGLE-TRACING OFF");
+ Current_Trace_Setting := Trace_Disable;
+ else
+ Current_Trace_Setting := save_trace;
+ end if;
+ Trace_On (Current_Trace_Setting);
+ if Current_Trace_Setting /= Trace_Disable then
+ Trace_Put ("TOGGLE-TRACING ON");
+ end if;
+ end loop;
+ -- #else c := Get_Keystroke;
+ return c;
+ end Getchar;
+
+ procedure Getchar (win : Window := Standard_Window) is
+ begin
+ if Getchar (win) < 0 then
+ Beep;
+ end if;
+ end Getchar;
+
+ procedure Pause is
+ begin
+ Move_Cursor (Line => Lines - 1, Column => 0);
+ Add (Str => "Press any key to continue... ");
+ Getchar;
+ end Pause;
+
+ procedure Cannot (s : String) is
+ use Interfaces.C;
+ use Interfaces.C.Strings;
+ use Terminal_Interface.Curses.Aux;
+ function getenv (x : char_array) return chars_ptr;
+ pragma Import (C, getenv, "getenv");
+ tmp1 : char_array (0 .. 10);
+ package p is new ncurses2.genericPuts (1024);
+ use p;
+ use p.BS;
+
+ tmpb : BS.Bounded_String;
+
+ Length : size_t;
+ begin
+ To_C ("TERM", tmp1, Length);
+ Fill_String (getenv (tmp1), tmpb);
+ Add (Ch => newl);
+ myAdd (Str => "This " & tmpb & " terminal " & s);
+ Pause;
+ end Cannot;
+
+ procedure ShellOut (message : Boolean) is
+ use Interfaces.C;
+ Txt : char_array (0 .. 10);
+ Length : size_t;
+ procedure system (x : char_array);
+ pragma Import (C, system, "system");
+ begin
+ To_C ("sh", Txt, Length);
+ if message then
+ Add (Str => "Shelling out...");
+ end if;
+ Save_Curses_Mode (Mode => Curses);
+ End_Windows;
+ system (Txt);
+ if message then
+ Add (Str => "returned from shellout.");
+ Add (Ch => newl);
+ end if;
+ Refresh;
+ end ShellOut;
+
+ function Is_Digit (c : Key_Code) return Boolean is
+ begin
+ if c >= 16#100# then
+ return False;
+ else
+ return Ada.Characters.Handling.Is_Digit (Character'Val (c));
+ end if;
+ end Is_Digit;
+
+ procedure P (s : String) is
+ begin
+ Add (Str => s);
+ Add (Ch => newl);
+ end P;
+
+ function Code_To_Char (c : Key_Code) return Character is
+ begin
+ if c > Character'Pos (Character'Last) then
+ return Character'Val (0);
+ -- maybe raise exception?
+ else
+ return Character'Val (c);
+ end if;
+ end Code_To_Char;
+
+ -- This was untestable due to a bug in GNAT (3.12p)
+ -- Hmm, what bug? I don't remember.
+ function ctoi (c : Character) return Integer is
+ begin
+ return Character'Pos (c) - Character'Pos ('0');
+ end ctoi;
+
+end ncurses2.util;
diff --git a/Ada95/samples/ncurses2-util.ads b/Ada95/samples/ncurses2-util.ads
new file mode 100644
index 0000000..f46749f
--- /dev/null
+++ b/Ada95/samples/ncurses2-util.ads
@@ -0,0 +1,76 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses2.util --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000,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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.2 $
+-- $Date: 2006/06/25 14:24:40 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+
+with Ada.Text_IO;
+package ncurses2.util is
+
+ Blank : constant Character := ' ';
+ Blank2 : constant Attributed_Character :=
+ (Ch => Blank, Attr => Normal_Video, Color => Color_Pair'First);
+
+ newl : constant Character := Character'Val (10);
+
+ function CTRL (c : Character) return Key_Code;
+
+ function CTRL (c : Character) return Character;
+
+ function Getchar (win : Window := Standard_Window) return Key_Code;
+
+ procedure Getchar (win : Window := Standard_Window);
+
+ procedure Pause;
+
+ procedure Cannot (s : String);
+
+ procedure ShellOut (message : Boolean);
+
+ package Int_IO is new Ada.Text_IO.Integer_IO (Integer);
+
+ function Is_Digit (c : Key_Code) return Boolean;
+
+ procedure P (s : String);
+
+ function Code_To_Char (c : Key_Code) return Character;
+ function ctoi (c : Character) return Integer;
+
+end ncurses2.util;
diff --git a/Ada95/samples/ncurses2.ads b/Ada95/samples/ncurses2.ads
new file mode 100644
index 0000000..2fe0197
--- /dev/null
+++ b/Ada95/samples/ncurses2.ads
@@ -0,0 +1,44 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+
+package ncurses2 is
+ pragma Pure (ncurses2);
+end ncurses2;
diff --git a/Ada95/samples/rain.adb b/Ada95/samples/rain.adb
new file mode 100644
index 0000000..d673018
--- /dev/null
+++ b/Ada95/samples/rain.adb
@@ -0,0 +1,179 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Rain --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2007,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: Laurent Pautet <pautet@gnat.com>
+-- Modified by: Juergen Pfeifer, 1997
+-- Version Control
+-- $Revision: 1.8 $
+-- $Date: 2008/08/30 21:38:07 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+-- --
+with ncurses2.util; use ncurses2.util;
+with Ada.Numerics.Float_Random; use Ada.Numerics.Float_Random;
+with Status; use Status;
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+
+procedure Rain is
+
+ Visibility : Cursor_Visibility;
+
+ subtype X_Position is Line_Position;
+ subtype Y_Position is Column_Position;
+
+ Xpos : array (1 .. 5) of X_Position;
+ Ypos : array (1 .. 5) of Y_Position;
+
+ done : Boolean;
+
+ c : Key_Code;
+
+ N : Integer;
+
+ G : Generator;
+
+ Max_X, X : X_Position;
+ Max_Y, Y : Y_Position;
+
+ procedure Next (J : in out Integer);
+ procedure Cursor (X : X_Position; Y : Y_Position);
+
+ procedure Next (J : in out Integer) is
+ begin
+ if J = 5 then
+ J := 1;
+ else
+ J := J + 1;
+ end if;
+ end Next;
+
+ procedure Cursor (X : X_Position; Y : Y_Position) is
+ begin
+ Move_Cursor (Line => X, Column => Y);
+ end Cursor;
+ pragma Inline (Cursor);
+
+begin
+
+ Init_Screen;
+ Set_NL_Mode;
+ Set_Echo_Mode (False);
+
+ Visibility := Invisible;
+ Set_Cursor_Visibility (Visibility);
+ Set_Timeout_Mode (Standard_Window, Non_Blocking, 0);
+
+ Max_X := Lines - 5;
+ Max_Y := Columns - 5;
+
+ for I in Xpos'Range loop
+ Xpos (I) := X_Position (Float (Max_X) * Random (G)) + 2;
+ Ypos (I) := Y_Position (Float (Max_Y) * Random (G)) + 2;
+ end loop;
+
+ N := 1;
+ done := False;
+ while not done and Process.Continue loop
+
+ X := X_Position (Float (Max_X) * Random (G)) + 2;
+ Y := Y_Position (Float (Max_Y) * Random (G)) + 2;
+
+ Cursor (X, Y);
+ Add (Ch => '.');
+
+ Cursor (Xpos (N), Ypos (N));
+ Add (Ch => 'o');
+
+ --
+ Next (N);
+ Cursor (Xpos (N), Ypos (N));
+ Add (Ch => 'O');
+
+ --
+ Next (N);
+ Cursor (Xpos (N) - 1, Ypos (N));
+ Add (Ch => '-');
+ Cursor (Xpos (N), Ypos (N) - 1);
+ Add (Str => "|.|");
+ Cursor (Xpos (N) + 1, Ypos (N));
+ Add (Ch => '-');
+
+ --
+ Next (N);
+ Cursor (Xpos (N) - 2, Ypos (N));
+ Add (Ch => '-');
+ Cursor (Xpos (N) - 1, Ypos (N) - 1);
+ Add (Str => "/\\");
+ Cursor (Xpos (N), Ypos (N) - 2);
+ Add (Str => "| O |");
+ Cursor (Xpos (N) + 1, Ypos (N) - 1);
+ Add (Str => "\\/");
+ Cursor (Xpos (N) + 2, Ypos (N));
+ Add (Ch => '-');
+
+ --
+ Next (N);
+ Cursor (Xpos (N) - 2, Ypos (N));
+ Add (Ch => ' ');
+ Cursor (Xpos (N) - 1, Ypos (N) - 1);
+ Add (Str => " ");
+ Cursor (Xpos (N), Ypos (N) - 2);
+ Add (Str => " ");
+ Cursor (Xpos (N) + 1, Ypos (N) - 1);
+ Add (Str => " ");
+ Cursor (Xpos (N) + 2, Ypos (N));
+ Add (Ch => ' ');
+
+ Xpos (N) := X;
+ Ypos (N) := Y;
+
+ c := Getchar;
+ case c is
+ when Character'Pos ('q') => done := True;
+ when Character'Pos ('Q') => done := True;
+ when Character'Pos ('s') => Set_NoDelay_Mode (Standard_Window, False);
+ when Character'Pos (' ') => Set_NoDelay_Mode (Standard_Window, True);
+ when others => null;
+ end case;
+
+ Nap_Milli_Seconds (50);
+ end loop;
+
+ Visibility := Normal;
+ Set_Cursor_Visibility (Visibility);
+ End_Windows;
+ Curses_Free_All;
+
+end Rain;
diff --git a/Ada95/samples/rain.ads b/Ada95/samples/rain.ads
new file mode 100644
index 0000000..3ad1912
--- /dev/null
+++ b/Ada95/samples/rain.ads
@@ -0,0 +1,43 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Rain --
+-- --
+-- 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: Laurent Pautet <pautet@gnat.com>
+-- Modified by: Juergen Pfeifer, 1997
+-- Version Control
+-- $Revision: 1.6 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+-- --
+procedure Rain;
diff --git a/Ada95/samples/sample-curses_demo-attributes.adb b/Ada95/samples/sample-curses_demo-attributes.adb
new file mode 100644
index 0000000..c49f37d
--- /dev/null
+++ b/Ada95/samples/sample-curses_demo-attributes.adb
@@ -0,0 +1,122 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Curses_Demo.Attributes --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control
+-- $Revision: 1.12 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
+
+with Sample.Manifest; use Sample.Manifest;
+with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
+with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
+with Sample.Explanation; use Sample.Explanation;
+
+package body Sample.Curses_Demo.Attributes is
+
+ procedure Demo
+ is
+ P : Panel := Create (Standard_Window);
+ K : Real_Key_Code;
+ begin
+ Set_Meta_Mode;
+ Set_KeyPad_Mode;
+
+ Top (P);
+
+ Push_Environment ("ATTRIBDEMO");
+ Default_Labels;
+ Notepad ("ATTRIB-PAD00");
+
+ Set_Character_Attributes (Attr => (others => False));
+ Add (Line => 1, Column => Columns / 2 - 10,
+ Str => "This is NORMAL");
+
+ Set_Character_Attributes (Attr => (Stand_Out => True,
+ others => False));
+ Add (Line => 2, Column => Columns / 2 - 10,
+ Str => "This is Stand_Out");
+
+ Set_Character_Attributes (Attr => (Under_Line => True,
+ others => False));
+ Add (Line => 3, Column => Columns / 2 - 10,
+ Str => "This is Under_Line");
+
+ Set_Character_Attributes (Attr => (Reverse_Video => True,
+ others => False));
+ Add (Line => 4, Column => Columns / 2 - 10,
+ Str => "This is Reverse_Video");
+
+ Set_Character_Attributes (Attr => (Blink => True,
+ others => False));
+ Add (Line => 5, Column => Columns / 2 - 10,
+ Str => "This is Blink");
+
+ Set_Character_Attributes (Attr => (Dim_Character => True,
+ others => False));
+ Add (Line => 6, Column => Columns / 2 - 10,
+ Str => "This is Dim_Character");
+
+ Set_Character_Attributes (Attr => (Bold_Character => True,
+ others => False));
+ Add (Line => 7, Column => Columns / 2 - 10,
+ Str => "This is Bold_Character");
+
+ Refresh_Without_Update;
+ Update_Panels; Update_Screen;
+
+ loop
+ K := Get_Key;
+ if K in Special_Key_Code'Range then
+ case K is
+ when QUIT_CODE => exit;
+ when HELP_CODE => Explain_Context;
+ when EXPLAIN_CODE => Explain ("ATTRIBKEYS");
+ when others => null;
+ end case;
+ end if;
+ end loop;
+
+ Pop_Environment;
+ Clear;
+ Refresh_Without_Update;
+ Delete (P);
+ Update_Panels; Update_Screen;
+
+ end Demo;
+
+end Sample.Curses_Demo.Attributes;
diff --git a/Ada95/samples/sample-curses_demo-attributes.ads b/Ada95/samples/sample-curses_demo-attributes.ads
new file mode 100644
index 0000000..6d9b4e8
--- /dev/null
+++ b/Ada95/samples/sample-curses_demo-attributes.ads
@@ -0,0 +1,45 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Curses_Demo.Attributes --
+-- --
+-- 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.9 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package Sample.Curses_Demo.Attributes is
+
+ procedure Demo;
+
+end Sample.Curses_Demo.Attributes;
diff --git a/Ada95/samples/sample-curses_demo-mouse.adb b/Ada95/samples/sample-curses_demo-mouse.adb
new file mode 100644
index 0000000..490685c
--- /dev/null
+++ b/Ada95/samples/sample-curses_demo-mouse.adb
@@ -0,0 +1,220 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Curses_Demo.Mouse --
+-- --
+-- 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.16 $
+-- $Date: 2008/07/26 18:48:19 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
+with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
+with Terminal_Interface.Curses.Text_IO; use Terminal_Interface.Curses.Text_IO;
+with Terminal_Interface.Curses.Text_IO.Integer_IO;
+with Terminal_Interface.Curses.Text_IO.Enumeration_IO;
+
+with Sample.Helpers; use Sample.Helpers;
+with Sample.Manifest; use Sample.Manifest;
+with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
+with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
+with Sample.Explanation; use Sample.Explanation;
+
+package body Sample.Curses_Demo.Mouse is
+
+ package Int_IO is new
+ Terminal_Interface.Curses.Text_IO.Integer_IO (Integer);
+ use Int_IO;
+
+ package Button_IO is new
+ Terminal_Interface.Curses.Text_IO.Enumeration_IO (Mouse_Button);
+ use Button_IO;
+
+ package State_IO is new
+ Terminal_Interface.Curses.Text_IO.Enumeration_IO (Button_State);
+ use State_IO;
+
+ procedure Demo is
+
+ type Controls is array (1 .. 3) of Panel;
+
+ Frame : Window;
+ Msg : Window;
+ Ctl : Controls;
+ Pan : Panel;
+ K : Real_Key_Code;
+ V : Cursor_Visibility := Invisible;
+ W : Window;
+ Note : Window;
+ Msg_L : constant Line_Count := 8;
+ Lins : Line_Position := Lines;
+ Cols : Column_Position;
+ Mask : Event_Mask;
+ procedure Show_Mouse_Event;
+
+ procedure Show_Mouse_Event
+ is
+ Evt : constant Mouse_Event := Get_Mouse;
+ Y : Line_Position;
+ X : Column_Position;
+ Button : Mouse_Button;
+ State : Button_State;
+ W : Window;
+ begin
+ Get_Event (Evt, Y, X, Button, State);
+ Put (Msg, "Event at");
+ Put (Msg, " X="); Put (Msg, Integer (X), 3);
+ Put (Msg, ", Y="); Put (Msg, Integer (Y), 3);
+ Put (Msg, ", Btn="); Put (Msg, Button, 10);
+ Put (Msg, ", Stat="); Put (Msg, State, 15);
+ for I in Ctl'Range loop
+ W := Get_Window (Ctl (I));
+ if Enclosed_In_Window (W, Evt) then
+ Transform_Coordinates (W, Y, X, From_Screen);
+ Put (Msg, ",Box(");
+ Put (Msg, (I), 1); Put (Msg, ",");
+ Put (Msg, Integer (Y), 1); Put (Msg, ",");
+ Put (Msg, Integer (X), 1); Put (Msg, ")");
+ end if;
+ end loop;
+ New_Line (Msg);
+ Flush (Msg);
+ Update_Panels; Update_Screen;
+ end Show_Mouse_Event;
+
+ begin
+ Push_Environment ("MOUSE00");
+ Notepad ("MOUSE-PAD00");
+ Default_Labels;
+ Set_Cursor_Visibility (V);
+
+ Note := Notepad_Window;
+ if Note /= Null_Window then
+ Get_Window_Position (Note, Lins, Cols);
+ end if;
+ Frame := Create (Msg_L, Columns, Lins - Msg_L, 0);
+ if Has_Colors then
+ Set_Background (Win => Frame,
+ Ch => (Color => Default_Colors,
+ Attr => Normal_Video,
+ Ch => ' '));
+ Set_Character_Attributes (Win => Frame,
+ Attr => Normal_Video,
+ Color => Default_Colors);
+ Erase (Frame);
+ end if;
+ Msg := Derived_Window (Frame, Msg_L - 2, Columns - 2, 1, 1);
+ Pan := Create (Frame);
+
+ Set_Meta_Mode;
+ Set_KeyPad_Mode;
+ Mask := Start_Mouse;
+
+ Box (Frame);
+ Window_Title (Frame, "Mouse Protocol");
+ Refresh_Without_Update (Frame);
+ Allow_Scrolling (Msg, True);
+
+ declare
+ Middle_Column : constant Integer := Integer (Columns) / 2;
+ Middle_Index : constant Natural := Ctl'First + (Ctl'Length / 2);
+ Width : constant Column_Count := 5;
+ Height : constant Line_Count := 3;
+ Half : constant Column_Count := Width / 2;
+ Space : constant Column_Count := 3;
+ Position : Integer;
+ W : Window;
+ begin
+ for I in Ctl'Range loop
+ Position := ((I) - Integer (Middle_Index)) *
+ Integer (Half + Space + Width) + Middle_Column;
+ W := Create (Height,
+ Width,
+ 1,
+ Column_Position (Position));
+ if Has_Colors then
+ Set_Background (Win => W,
+ Ch => (Color => Menu_Back_Color,
+ Attr => Normal_Video,
+ Ch => ' '));
+ Set_Character_Attributes (Win => W,
+ Attr => Normal_Video,
+ Color => Menu_Fore_Color);
+ Erase (W);
+ end if;
+ Ctl (I) := Create (W);
+ Box (W);
+ Move_Cursor (W, 1, Half);
+ Put (W, (I), 1);
+ Refresh_Without_Update (W);
+ end loop;
+ end;
+
+ Update_Panels; Update_Screen;
+
+ loop
+ K := Get_Key;
+ if K in Special_Key_Code'Range then
+ case K is
+ when QUIT_CODE => exit;
+ when HELP_CODE => Explain_Context;
+ when EXPLAIN_CODE => Explain ("MOUSEKEYS");
+ when Key_Mouse => Show_Mouse_Event;
+ when others => null;
+ end case;
+ end if;
+ end loop;
+
+ for I in Ctl'Range loop
+ W := Get_Window (Ctl (I));
+ Clear (W);
+ Delete (Ctl (I));
+ Delete (W);
+ end loop;
+
+ Clear (Frame);
+ Delete (Pan);
+ Delete (Msg);
+ Delete (Frame);
+
+ Set_Cursor_Visibility (V);
+ End_Mouse (Mask);
+
+ Pop_Environment;
+ Update_Panels; Update_Screen;
+
+ end Demo;
+
+end Sample.Curses_Demo.Mouse;
diff --git a/Ada95/samples/sample-curses_demo-mouse.ads b/Ada95/samples/sample-curses_demo-mouse.ads
new file mode 100644
index 0000000..ad78d0d
--- /dev/null
+++ b/Ada95/samples/sample-curses_demo-mouse.ads
@@ -0,0 +1,45 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Curses_Demo.Mouse --
+-- --
+-- 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.9 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package Sample.Curses_Demo.Mouse is
+
+ procedure Demo;
+
+end Sample.Curses_Demo.Mouse;
diff --git a/Ada95/samples/sample-curses_demo.adb b/Ada95/samples/sample-curses_demo.adb
new file mode 100644
index 0000000..700da76
--- /dev/null
+++ b/Ada95/samples/sample-curses_demo.adb
@@ -0,0 +1,143 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Curses_Demo --
+-- --
+-- 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.15 $
+-- $Date: 2004/08/21 21:37:00 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus;
+with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
+with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
+with Terminal_Interface.Curses.Panels.User_Data;
+
+with Sample.Manifest; use Sample.Manifest;
+with Sample.Helpers; use Sample.Helpers;
+with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
+
+with Sample.Explanation; use Sample.Explanation;
+
+with Sample.Menu_Demo.Handler;
+with Sample.Curses_Demo.Mouse;
+with Sample.Curses_Demo.Attributes;
+
+package body Sample.Curses_Demo is
+
+ type User_Data is new Integer;
+ type User_Data_Access is access all User_Data;
+ package PUD is new Panels.User_Data (User_Data, User_Data_Access);
+ -- We use above instantiation of the generic User_Data package to
+ -- demonstrate and test the use of the user data maechanism.
+
+ procedure Demo
+ is
+ function My_Driver (M : Menu;
+ K : Key_Code;
+ Pan : Panel) return Boolean;
+ package Mh is new Sample.Menu_Demo.Handler (My_Driver);
+
+ Itm : Item_Array_Access := new Item_Array'
+ (New_Item ("Attributes Demo"),
+ New_Item ("Mouse Demo"),
+ Null_Item);
+ M : Menu := New_Menu (Itm);
+ U1 : constant User_Data_Access := new User_Data'(4711);
+ U2 : User_Data_Access;
+
+ function My_Driver (M : Menu;
+ K : Key_Code;
+ Pan : Panel) return Boolean
+ is
+ Idx : constant Positive := Get_Index (Current (M));
+ Result : Boolean := False;
+ begin
+ PUD.Set_User_Data (Pan, U1); -- set some user data, just for fun
+ if K in User_Key_Code'Range then
+ if K = QUIT then
+ Result := True;
+ elsif K = SELECT_ITEM then
+ if Idx in Itm'Range then
+ Hide (Pan);
+ Update_Panels;
+ end if;
+ case Idx is
+ when 1 => Sample.Curses_Demo.Attributes.Demo;
+ when 2 => Sample.Curses_Demo.Mouse.Demo;
+ when others => Not_Implemented;
+ end case;
+ if Idx in Itm'Range then
+ Top (Pan);
+ Show (Pan);
+ Update_Panels;
+ Update_Screen;
+ end if;
+ end if;
+ end if;
+ PUD.Get_User_Data (Pan, U2); -- get the user data
+ pragma Assert (U1.all = U2.all and then U1 = U2);
+ return Result;
+ end My_Driver;
+
+ begin
+
+ if (1 + Item_Count (M)) /= Itm'Length then
+ raise Constraint_Error;
+ end if;
+
+ if not Has_Mouse then
+ declare
+ O : Item_Option_Set;
+ begin
+ Get_Options (Itm (2), O);
+ O.Selectable := False;
+ Set_Options (Itm (2), O);
+ end;
+ end if;
+
+ Push_Environment ("CURSES00");
+ Notepad ("CURSES-PAD00");
+ Default_Labels;
+ Refresh_Soft_Label_Keys_Without_Update;
+
+ Mh.Drive_Me (M, " Demo ");
+ Pop_Environment;
+
+ Delete (M);
+ Free (Itm, True);
+ end Demo;
+
+end Sample.Curses_Demo;
diff --git a/Ada95/samples/sample-curses_demo.ads b/Ada95/samples/sample-curses_demo.ads
new file mode 100644
index 0000000..ed4ad0f
--- /dev/null
+++ b/Ada95/samples/sample-curses_demo.ads
@@ -0,0 +1,45 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Curses_Demo --
+-- --
+-- 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.9 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package Sample.Curses_Demo is
+
+ procedure Demo;
+
+end Sample.Curses_Demo;
diff --git a/Ada95/samples/sample-explanation.adb b/Ada95/samples/sample-explanation.adb
new file mode 100644
index 0000000..12a8deb
--- /dev/null
+++ b/Ada95/samples/sample-explanation.adb
@@ -0,0 +1,408 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Explanation --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2004,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.20 $
+-- $Date: 2006/06/25 14:30:22 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+-- Poor mans help system. This scans a sequential file for key lines and
+-- then reads the lines up to the next key. Those lines are presented in
+-- a window as help or explanation.
+--
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Unchecked_Deallocation;
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
+
+with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
+with Sample.Manifest; use Sample.Manifest;
+with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
+with Sample.Helpers; use Sample.Helpers;
+
+package body Sample.Explanation is
+
+ Help_Keys : constant String := "HELPKEYS";
+ In_Help : constant String := "INHELP";
+
+ File_Name : constant String := "explain.msg";
+ F : File_Type;
+
+ type Help_Line;
+ type Help_Line_Access is access Help_Line;
+ pragma Controlled (Help_Line_Access);
+ type String_Access is access String;
+ pragma Controlled (String_Access);
+
+ type Help_Line is
+ record
+ Prev, Next : Help_Line_Access;
+ Line : String_Access;
+ end record;
+
+ procedure Explain (Key : in String;
+ Win : in Window);
+
+ procedure Release_String is
+ new Ada.Unchecked_Deallocation (String,
+ String_Access);
+ procedure Release_Help_Line is
+ new Ada.Unchecked_Deallocation (Help_Line,
+ Help_Line_Access);
+
+ function Search (Key : String) return Help_Line_Access;
+ procedure Release_Help (Root : in out Help_Line_Access);
+
+ procedure Explain (Key : in String)
+ is
+ begin
+ Explain (Key, Null_Window);
+ end Explain;
+
+ procedure Explain (Key : in String;
+ Win : in Window)
+ is
+ -- Retrieve the text associated with this key and display it in this
+ -- window. If no window argument is passed, the routine will create
+ -- a temporary window and use it.
+
+ function Filter_Key return Real_Key_Code;
+ procedure Unknown_Key;
+ procedure Redo;
+ procedure To_Window (C : in out Help_Line_Access;
+ More : in out Boolean);
+
+ Frame : Window := Null_Window;
+
+ W : Window := Win;
+ K : Real_Key_Code;
+ P : Panel;
+
+ Height : Line_Count;
+ Width : Column_Count;
+ Help : Help_Line_Access := Search (Key);
+ Current : Help_Line_Access;
+ Top_Line : Help_Line_Access;
+
+ Has_More : Boolean := True;
+
+ procedure Unknown_Key
+ is
+ begin
+ Add (W, "Help message with ID ");
+ Add (W, Key);
+ Add (W, " not found.");
+ Add (W, Character'Val (10));
+ Add (W, "Press the Function key labelled 'Quit' key to continue.");
+ end Unknown_Key;
+
+ procedure Redo
+ is
+ H : Help_Line_Access := Top_Line;
+ begin
+ if Top_Line /= null then
+ for L in 0 .. (Height - 1) loop
+ Add (W, L, 0, H.Line.all);
+ exit when H.Next = null;
+ H := H.Next;
+ end loop;
+ else
+ Unknown_Key;
+ end if;
+ end Redo;
+
+ function Filter_Key return Real_Key_Code
+ is
+ K : Real_Key_Code;
+ begin
+ loop
+ K := Get_Key (W);
+ if K in Special_Key_Code'Range then
+ case K is
+ when HELP_CODE =>
+ if not Find_Context (In_Help) then
+ Push_Environment (In_Help, False);
+ Explain (In_Help, W);
+ Pop_Environment;
+ Redo;
+ end if;
+ when EXPLAIN_CODE =>
+ if not Find_Context (Help_Keys) then
+ Push_Environment (Help_Keys, False);
+ Explain (Help_Keys, W);
+ Pop_Environment;
+ Redo;
+ end if;
+ when others => exit;
+ end case;
+ else
+ exit;
+ end if;
+ end loop;
+ return K;
+ end Filter_Key;
+
+ procedure To_Window (C : in out Help_Line_Access;
+ More : in out Boolean)
+ is
+ L : Line_Position := 0;
+ begin
+ loop
+ Add (W, L, 0, C.Line.all);
+ L := L + 1;
+ exit when C.Next = null or else L = Height;
+ C := C.Next;
+ end loop;
+ if C.Next /= null then
+ pragma Assert (L = Height);
+ More := True;
+ else
+ More := False;
+ end if;
+ end To_Window;
+
+ begin
+ if W = Null_Window then
+ Push_Environment ("HELP");
+ Default_Labels;
+ Frame := New_Window (Lines - 2, Columns, 0, 0);
+ if Has_Colors then
+ Set_Background (Win => Frame,
+ Ch => (Ch => ' ',
+ Color => Help_Color,
+ Attr => Normal_Video));
+ Set_Character_Attributes (Win => Frame,
+ Attr => Normal_Video,
+ Color => Help_Color);
+ Erase (Frame);
+ end if;
+ Box (Frame);
+ Set_Character_Attributes (Frame, (Reverse_Video => True,
+ others => False));
+ Add (Frame, Lines - 3, 2, "Cursor Up/Down scrolls");
+ Set_Character_Attributes (Frame); -- Back to default.
+ Window_Title (Frame, "Explanation");
+ W := Derived_Window (Frame, Lines - 4, Columns - 2, 1, 1);
+ Refresh_Without_Update (Frame);
+ Get_Size (W, Height, Width);
+ Set_Meta_Mode (W);
+ Set_KeyPad_Mode (W);
+ Allow_Scrolling (W, True);
+ Set_Echo_Mode (False);
+ P := Create (Frame);
+ Top (P);
+ Update_Panels;
+ else
+ Clear (W);
+ Refresh_Without_Update (W);
+ end if;
+
+ Current := Help; Top_Line := Help;
+
+ if null = Help then
+ Unknown_Key;
+ loop
+ K := Filter_Key;
+ exit when K = QUIT_CODE;
+ end loop;
+ else
+ To_Window (Current, Has_More);
+ if Has_More then
+ -- This means there are more lines available, so we have to go
+ -- into a scroll manager.
+ loop
+ K := Filter_Key;
+ if K in Special_Key_Code'Range then
+ case K is
+ when Key_Cursor_Down =>
+ if Current.Next /= null then
+ Move_Cursor (W, Height - 1, 0);
+ Scroll (W, 1);
+ Current := Current.Next;
+ Top_Line := Top_Line.Next;
+ Add (W, Current.Line.all);
+ end if;
+ when Key_Cursor_Up =>
+ if Top_Line.Prev /= null then
+ Move_Cursor (W, 0, 0);
+ Scroll (W, -1);
+ Top_Line := Top_Line.Prev;
+ Current := Current.Prev;
+ Add (W, Top_Line.Line.all);
+ end if;
+ when QUIT_CODE => exit;
+ when others => null;
+ end case;
+ end if;
+ end loop;
+ else
+ loop
+ K := Filter_Key;
+ exit when K = QUIT_CODE;
+ end loop;
+ end if;
+ end if;
+
+ Clear (W);
+
+ if Frame /= Null_Window then
+ Clear (Frame);
+ Delete (P);
+ Delete (W);
+ Delete (Frame);
+ Pop_Environment;
+ end if;
+
+ Update_Panels;
+ Update_Screen;
+
+ Release_Help (Help);
+
+ end Explain;
+
+ function Search (Key : String) return Help_Line_Access
+ is
+ Last : Natural;
+ Buffer : String (1 .. 256);
+ Root : Help_Line_Access := null;
+ Current : Help_Line_Access;
+ Tail : Help_Line_Access := null;
+
+ function Next_Line return Boolean;
+
+ function Next_Line return Boolean
+ is
+ H_End : constant String := "#END";
+ begin
+ Get_Line (F, Buffer, Last);
+ if Last = H_End'Length and then H_End = Buffer (1 .. Last) then
+ return False;
+ else
+ return True;
+ end if;
+ end Next_Line;
+ begin
+ Reset (F);
+ Outer :
+ loop
+ exit Outer when not Next_Line;
+ if Last = (1 + Key'Length) and then Key = Buffer (2 .. Last)
+ and then Buffer (1) = '#' then
+ loop
+ exit when not Next_Line;
+ exit when Buffer (1) = '#';
+ Current := new Help_Line'(null, null,
+ new String'(Buffer (1 .. Last)));
+ if Tail = null then
+ Release_Help (Root);
+ Root := Current;
+ else
+ Tail.Next := Current;
+ Current.Prev := Tail;
+ end if;
+ Tail := Current;
+ end loop;
+ exit Outer;
+ end if;
+ end loop Outer;
+ return Root;
+ end Search;
+
+ procedure Release_Help (Root : in out Help_Line_Access)
+ is
+ Next : Help_Line_Access;
+ begin
+ loop
+ exit when Root = null;
+ Next := Root.Next;
+ Release_String (Root.Line);
+ Release_Help_Line (Root);
+ Root := Next;
+ end loop;
+ end Release_Help;
+
+ procedure Explain_Context
+ is
+ begin
+ Explain (Context);
+ end Explain_Context;
+
+ procedure Notepad (Key : in String)
+ is
+ H : constant Help_Line_Access := Search (Key);
+ T : Help_Line_Access := H;
+ N : Line_Count := 1;
+ L : Line_Position := 0;
+ W : Window;
+ P : Panel;
+ begin
+ if H /= null then
+ loop
+ T := T.Next;
+ exit when T = null;
+ N := N + 1;
+ end loop;
+ W := New_Window (N + 2, Columns, Lines - N - 2, 0);
+ if Has_Colors then
+ Set_Background (Win => W,
+ Ch => (Ch => ' ',
+ Color => Notepad_Color,
+ Attr => Normal_Video));
+ Set_Character_Attributes (Win => W,
+ Attr => Normal_Video,
+ Color => Notepad_Color);
+ Erase (W);
+ end if;
+ Box (W);
+ Window_Title (W, "Notepad");
+ P := New_Panel (W);
+ T := H;
+ loop
+ Add (W, L + 1, 1, T.Line.all, Integer (Columns - 2));
+ L := L + 1;
+ T := T.Next;
+ exit when T = null;
+ end loop;
+ T := H;
+ Release_Help (T);
+ Refresh_Without_Update (W);
+ Notepad_To_Context (P);
+ end if;
+ end Notepad;
+
+begin
+ Open (F, In_File, File_Name);
+end Sample.Explanation;
diff --git a/Ada95/samples/sample-explanation.ads b/Ada95/samples/sample-explanation.ads
new file mode 100644
index 0000000..18617ac
--- /dev/null
+++ b/Ada95/samples/sample-explanation.ads
@@ -0,0 +1,59 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Explanation --
+-- --
+-- 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
+------------------------------------------------------------------------------
+-- Poor mans help system. This scans a sequential file for key lines and
+-- then reads the lines up to the next key. Those lines are presented in
+-- a window as help or explanation.
+--
+package Sample.Explanation is
+
+ procedure Explain (Key : in String);
+ -- Retrieve the text associated with this key and display it.
+
+ procedure Explain_Context;
+ -- Explain the current context.
+
+ procedure Notepad (Key : in String);
+ -- Put a note on the screen and maintain it with the context
+
+ Explanation_Not_Found : exception;
+ Explanation_Error : exception;
+
+end Sample.Explanation;
diff --git a/Ada95/samples/sample-form_demo-aux.adb b/Ada95/samples/sample-form_demo-aux.adb
new file mode 100644
index 0000000..81c97ad
--- /dev/null
+++ b/Ada95/samples/sample-form_demo-aux.adb
@@ -0,0 +1,263 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Form_Demo.Aux --
+-- --
+-- 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.16 $
+-- $Date: 2004/08/21 21:37:00 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
+
+with Sample.Manifest; use Sample.Manifest;
+with Sample.Helpers; use Sample.Helpers;
+with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
+with Sample.Explanation; use Sample.Explanation;
+
+package body Sample.Form_Demo.Aux is
+
+ procedure Geometry (F : in Form;
+ L : out Line_Count; -- Lines used for menu
+ C : out Column_Count; -- Columns used for menu
+ Y : out Line_Position; -- Proposed Line for menu
+ X : out Column_Position) -- Proposed Column for menu
+ is
+ begin
+ Scale (F, L, C);
+
+ L := L + 2; -- count for frame at top and bottom
+ C := C + 2; -- "
+
+ -- Calculate horizontal coordinate at the screen center
+ X := (Columns - C) / 2;
+ Y := 1; -- start always in line 1
+ end Geometry;
+
+ function Create (F : Form;
+ Title : String;
+ Lin : Line_Position;
+ Col : Column_Position) return Panel
+ is
+ W, S : Window;
+ L : Line_Count;
+ C : Column_Count;
+ Y : Line_Position;
+ X : Column_Position;
+ Pan : Panel;
+ begin
+ Geometry (F, L, C, Y, X);
+ W := New_Window (L, C, Lin, Col);
+ Set_Meta_Mode (W);
+ Set_KeyPad_Mode (W);
+ if Has_Colors then
+ Set_Background (Win => W,
+ Ch => (Ch => ' ',
+ Color => Default_Colors,
+ Attr => Normal_Video));
+ Set_Character_Attributes (Win => W,
+ Color => Default_Colors,
+ Attr => Normal_Video);
+ Erase (W);
+ end if;
+ S := Derived_Window (W, L - 2, C - 2, 1, 1);
+ Set_Meta_Mode (S);
+ Set_KeyPad_Mode (S);
+ Box (W);
+ Set_Window (F, W);
+ Set_Sub_Window (F, S);
+ if Title'Length > 0 then
+ Window_Title (W, Title);
+ end if;
+ Pan := New_Panel (W);
+ Post (F);
+ return Pan;
+ end Create;
+
+ procedure Destroy (F : in Form;
+ P : in out Panel)
+ is
+ W, S : Window;
+ begin
+ W := Get_Window (F);
+ S := Get_Sub_Window (F);
+ Post (F, False);
+ Erase (W);
+ Delete (P);
+ Set_Window (F, Null_Window);
+ Set_Sub_Window (F, Null_Window);
+ Delete (S);
+ Delete (W);
+ Update_Panels;
+ end Destroy;
+
+ function Get_Request (F : Form;
+ P : Panel;
+ Handle_CRLF : Boolean := True) return Key_Code
+ is
+ W : constant Window := Get_Window (F);
+ K : Real_Key_Code;
+ Ch : Character;
+ begin
+ Top (P);
+ loop
+ K := Get_Key (W);
+ if K in Special_Key_Code'Range then
+ case K is
+ when HELP_CODE => Explain_Context;
+ when EXPLAIN_CODE => Explain ("FORMKEYS");
+ when Key_Home => return F_First_Field;
+ when Key_End => return F_Last_Field;
+ when QUIT_CODE => return QUIT;
+ when Key_Cursor_Down => return F_Down_Char;
+ when Key_Cursor_Up => return F_Up_Char;
+ when Key_Cursor_Left => return F_Previous_Char;
+ when Key_Cursor_Right => return F_Next_Char;
+ when Key_Next_Page => return F_Next_Page;
+ when Key_Previous_Page => return F_Previous_Page;
+ when Key_Backspace => return F_Delete_Previous;
+ when Key_Clear_Screen => return F_Clear_Field;
+ when Key_Clear_End_Of_Line => return F_Clear_EOF;
+ when others => return K;
+ end case;
+ elsif K in Normal_Key_Code'Range then
+ Ch := Character'Val (K);
+ case Ch is
+ when CAN => return QUIT; -- CTRL-X
+
+ when ACK => return F_Next_Field; -- CTRL-F
+ when STX => return F_Previous_Field; -- CTRL-B
+ when FF => return F_Left_Field; -- CTRL-L
+ when DC2 => return F_Right_Field; -- CTRL-R
+ when NAK => return F_Up_Field; -- CTRL-U
+ when EOT => return F_Down_Field; -- CTRL-D
+
+ when ETB => return F_Next_Word; -- CTRL-W
+ when DC4 => return F_Previous_Word; -- CTRL-T
+
+ when SOH => return F_Begin_Field; -- CTRL-A
+ when ENQ => return F_End_Field; -- CTRL-E
+
+ when HT => return F_Insert_Char; -- CTRL-I
+ when SI => return F_Insert_Line; -- CTRL-O
+ when SYN => return F_Delete_Char; -- CTRL-V
+ when BS => return F_Delete_Previous; -- CTRL-H
+ when EM => return F_Delete_Line; -- CTRL-Y
+ when BEL => return F_Delete_Word; -- CTRL-G
+ when VT => return F_Clear_EOF; -- CTRL-K
+
+ when SO => return F_Next_Choice; -- CTRL-N
+ when DLE => return F_Previous_Choice; -- CTRL-P
+
+ when CR | LF =>
+ if Handle_CRLF then
+ return F_New_Line;
+ else
+ return K;
+ end if;
+ when others => return K;
+ end case;
+ else
+ return K;
+ end if;
+ end loop;
+ end Get_Request;
+
+ function Make (Top : Line_Position;
+ Left : Column_Position;
+ Text : String) return Field
+ is
+ Fld : Field;
+ C : constant Column_Count := Column_Count (Text'Length);
+ begin
+ Fld := New_Field (1, C, Top, Left);
+ Set_Buffer (Fld, 0, Text);
+ Switch_Options (Fld, (Active => True, others => False), False);
+ if Has_Colors then
+ Set_Background (Fld => Fld, Color => Default_Colors);
+ end if;
+ return Fld;
+ end Make;
+
+ function Make (Height : Line_Count := 1;
+ Width : Column_Count;
+ Top : Line_Position;
+ Left : Column_Position;
+ Off_Screen : Natural := 0) return Field
+ is
+ Fld : constant Field := New_Field (Height, Width, Top, Left, Off_Screen);
+ begin
+ if Has_Colors then
+ Set_Foreground (Fld => Fld, Color => Form_Fore_Color);
+ Set_Background (Fld => Fld, Color => Form_Back_Color);
+ else
+ Set_Background (Fld, (Reverse_Video => True, others => False));
+ end if;
+ return Fld;
+ end Make;
+
+ function Default_Driver (F : Form;
+ K : Key_Code;
+ P : Panel) return Boolean
+ is
+ begin
+ if P = Null_Panel then
+ raise Panel_Exception;
+ end if;
+ if K in User_Key_Code'Range and then K = QUIT then
+ if Driver (F, F_Validate_Field) = Form_Ok then
+ return True;
+ end if;
+ end if;
+ return False;
+ end Default_Driver;
+
+ function Count_Active (F : Form) return Natural
+ is
+ N : Natural := 0;
+ O : Field_Option_Set;
+ H : constant Natural := Field_Count (F);
+ begin
+ if H > 0 then
+ for I in 1 .. H loop
+ Get_Options (Fields (F, I), O);
+ if O.Active then
+ N := N + 1;
+ end if;
+ end loop;
+ end if;
+ return N;
+ end Count_Active;
+
+end Sample.Form_Demo.Aux;
diff --git a/Ada95/samples/sample-form_demo-aux.ads b/Ada95/samples/sample-form_demo-aux.ads
new file mode 100644
index 0000000..2317e14
--- /dev/null
+++ b/Ada95/samples/sample-form_demo-aux.ads
@@ -0,0 +1,92 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Form_Demo.Aux --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control
+-- $Revision: 1.9 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
+with Terminal_Interface.Curses.Forms; use Terminal_Interface.Curses.Forms;
+
+package Sample.Form_Demo.Aux is
+
+ procedure Geometry (F : in Form;
+ L : out Line_Count;
+ C : out Column_Count;
+ Y : out Line_Position;
+ X : out Column_Position);
+ -- Calculate the geometry for a panel beeing able to be used to display
+ -- the menu.
+
+ function Create (F : Form;
+ Title : String;
+ Lin : Line_Position;
+ Col : Column_Position) return Panel;
+ -- Create a panel decorated with a frame and the title at the specified
+ -- position. The dimension of the panel is derived from the menus layout.
+
+ procedure Destroy (F : in Form;
+ P : in out Panel);
+ -- Destroy all the windowing structures associated with this menu and
+ -- panel.
+
+ function Get_Request (F : Form;
+ P : Panel;
+ Handle_CRLF : Boolean := True) return Key_Code;
+ -- Centralized request driver for all menus in this sample. This
+ -- gives us a common key binding for all menus.
+
+ function Make (Top : Line_Position;
+ Left : Column_Position;
+ Text : String) return Field;
+ -- create a label
+
+ function Make (Height : Line_Count := 1;
+ Width : Column_Count;
+ Top : Line_Position;
+ Left : Column_Position;
+ Off_Screen : Natural := 0) return Field;
+ -- create a editable field
+
+ function Default_Driver (F : Form;
+ K : Key_Code;
+ P : Panel) return Boolean;
+
+ function Count_Active (F : Form) return Natural;
+ -- Count the number of active fields in the form
+
+end Sample.Form_Demo.Aux;
diff --git a/Ada95/samples/sample-form_demo-handler.adb b/Ada95/samples/sample-form_demo-handler.adb
new file mode 100644
index 0000000..afe86f7
--- /dev/null
+++ b/Ada95/samples/sample-form_demo-handler.adb
@@ -0,0 +1,98 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Form_Demo.Handler --
+-- --
+-- 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.13 $
+-- $Date: 2004/08/21 21:37:00 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Sample.Form_Demo.Aux;
+
+package body Sample.Form_Demo.Handler is
+
+ package Aux renames Sample.Form_Demo.Aux;
+
+ procedure Drive_Me (F : in Form;
+ Title : in String := "")
+ is
+ L : Line_Count;
+ C : Column_Count;
+ Y : Line_Position;
+ X : Column_Position;
+ begin
+ Aux.Geometry (F, L, C, Y, X);
+ Drive_Me (F, Y, X, Title);
+ end Drive_Me;
+
+ procedure Drive_Me (F : in Form;
+ Lin : in Line_Position;
+ Col : in Column_Position;
+ Title : in String := "")
+ is
+ Pan : Panel := Aux.Create (F, Title, Lin, Col);
+ V : Cursor_Visibility := Normal;
+ Handle_CRLF : Boolean := True;
+
+ begin
+ Set_Cursor_Visibility (V);
+ if Aux.Count_Active (F) = 1 then
+ Handle_CRLF := False;
+ end if;
+ loop
+ declare
+ K : constant Key_Code := Aux.Get_Request (F, Pan, Handle_CRLF);
+ R : Driver_Result;
+ begin
+ if (K = 13 or else K = 10) and then not Handle_CRLF then
+ R := Unknown_Request;
+ else
+ R := Driver (F, K);
+ end if;
+ case R is
+ when Form_Ok => null;
+ when Unknown_Request =>
+ if My_Driver (F, K, Pan) then
+ exit;
+ end if;
+ when others => Beep;
+ end case;
+ end;
+ end loop;
+ Set_Cursor_Visibility (V);
+ Aux.Destroy (F, Pan);
+ end Drive_Me;
+
+end Sample.Form_Demo.Handler;
diff --git a/Ada95/samples/sample-form_demo-handler.ads b/Ada95/samples/sample-form_demo-handler.ads
new file mode 100644
index 0000000..4a56412
--- /dev/null
+++ b/Ada95/samples/sample-form_demo-handler.ads
@@ -0,0 +1,64 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Form_Demo.Handler --
+-- --
+-- 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.9 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses;
+use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Panels;
+use Terminal_Interface.Curses.Panels;
+with Terminal_Interface.Curses.Forms;
+use Terminal_Interface.Curses.Forms;
+
+generic
+ with function My_Driver (Frm : Form;
+ K : Key_Code;
+ Pan : Panel) return Boolean;
+package Sample.Form_Demo.Handler is
+
+ procedure Drive_Me (F : in Form;
+ Lin : in Line_Position;
+ Col : in Column_Position;
+ Title : in String := "");
+ -- Position the menu at the given point and drive it.
+
+ procedure Drive_Me (F : in Form;
+ Title : in String := "");
+ -- Center menu and drive it.
+
+end Sample.Form_Demo.Handler;
diff --git a/Ada95/samples/sample-form_demo.adb b/Ada95/samples/sample-form_demo.adb
new file mode 100644
index 0000000..e26a5d9
--- /dev/null
+++ b/Ada95/samples/sample-form_demo.adb
@@ -0,0 +1,130 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Form_Demo --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2004,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.15 $
+-- $Date: 2006/06/25 14:30:22 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Forms; use Terminal_Interface.Curses.Forms;
+with Terminal_Interface.Curses.Forms.Field_User_Data;
+with Sample.My_Field_Type; use Sample.My_Field_Type;
+with Sample.Explanation; use Sample.Explanation;
+with Sample.Form_Demo.Aux; use Sample.Form_Demo.Aux;
+with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
+with Sample.Form_Demo.Handler;
+
+with Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada;
+with Terminal_Interface.Curses.Forms.Field_Types.Enumeration;
+use Terminal_Interface.Curses.Forms.Field_Types.Enumeration;
+with Terminal_Interface.Curses.Forms.Field_Types.IntField;
+use Terminal_Interface.Curses.Forms.Field_Types.IntField;
+
+package body Sample.Form_Demo is
+
+ type User_Data is
+ record
+ Data : Integer;
+ end record;
+ type User_Access is access User_Data;
+
+ package Fld_U is new
+ Terminal_Interface.Curses.Forms.Field_User_Data (User_Data,
+ User_Access);
+
+ type Weekday is (Sunday, Monday, Tuesday, Wednesday, Thursday,
+ Friday, Saturday);
+
+ package Weekday_Enum is new
+ Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada (Weekday);
+
+ Enum_Field : constant Enumeration_Field :=
+ Weekday_Enum.Create;
+
+ procedure Demo
+ is
+
+ Mft : constant My_Data := (Ch => 'X');
+
+ FA : Field_Array_Access := new Field_Array'
+ (Make (0, 14, "Sample Entry Form"),
+ Make (2, 0, "WeekdayEnumeration"),
+ Make (2, 20, "Numeric 1-10"),
+ Make (2, 34, "Only 'X'"),
+ Make (5, 0, "Multiple Lines offscreen(Scroll)"),
+ Make (Width => 18, Top => 3, Left => 0),
+ Make (Width => 12, Top => 3, Left => 20),
+ Make (Width => 12, Top => 3, Left => 34),
+ Make (Width => 46, Top => 6, Left => 0, Height => 4, Off_Screen => 2),
+ Null_Field
+ );
+
+ Frm : Terminal_Interface.Curses.Forms.Form := Create (FA);
+
+ I_F : constant Integer_Field := (Precision => 0,
+ Lower_Limit => 1,
+ Upper_Limit => 10);
+
+ F1, F2 : User_Access;
+
+ package Fh is new Sample.Form_Demo.Handler (Default_Driver);
+
+ begin
+ Push_Environment ("FORM00");
+ Notepad ("FORM-PAD00");
+ Default_Labels;
+
+ Set_Field_Type (FA (6), Enum_Field);
+ Set_Field_Type (FA (7), I_F);
+ Set_Field_Type (FA (8), Mft);
+
+ F1 := new User_Data'(Data => 4711);
+ Fld_U.Set_User_Data (FA (1), F1);
+
+ Fh.Drive_Me (Frm);
+
+ Fld_U.Get_User_Data (FA (1), F2);
+ pragma Assert (F1 = F2);
+ pragma Assert (F1.Data = F2.Data);
+
+ Pop_Environment;
+ Delete (Frm);
+
+ Free (FA, True);
+ end Demo;
+
+end Sample.Form_Demo;
diff --git a/Ada95/samples/sample-form_demo.ads b/Ada95/samples/sample-form_demo.ads
new file mode 100644
index 0000000..bd33f57
--- /dev/null
+++ b/Ada95/samples/sample-form_demo.ads
@@ -0,0 +1,45 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Form_Demo --
+-- --
+-- 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.9 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package Sample.Form_Demo is
+
+ procedure Demo;
+
+end Sample.Form_Demo;
diff --git a/Ada95/samples/sample-function_key_setting.adb b/Ada95/samples/sample-function_key_setting.adb
new file mode 100644
index 0000000..e40e4a4
--- /dev/null
+++ b/Ada95/samples/sample-function_key_setting.adb
@@ -0,0 +1,214 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Function_Key_Setting --
+-- --
+-- 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.13 $
+-- $Date: 2004/08/21 21:37:00 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Unchecked_Deallocation;
+with Sample.Manifest; use Sample.Manifest;
+
+-- This package implements a simple stack of function key label environments.
+--
+package body Sample.Function_Key_Setting is
+
+ Max_Label_Length : constant Positive := 8;
+ Number_Of_Keys : Label_Number := Label_Number'Last;
+ Justification : Label_Justification := Left;
+
+ subtype Label is String (1 .. Max_Label_Length);
+ type Label_Array is array (Label_Number range <>) of Label;
+
+ type Key_Environment (N : Label_Number := Label_Number'Last);
+ type Env_Ptr is access Key_Environment;
+ pragma Controlled (Env_Ptr);
+
+ type String_Access is access String;
+ pragma Controlled (String_Access);
+
+ Active_Context : String_Access := new String'("MAIN");
+ Active_Notepad : Panel := Null_Panel;
+
+ type Key_Environment (N : Label_Number := Label_Number'Last) is
+ record
+ Prev : Env_Ptr;
+ Help : String_Access;
+ Notepad : Panel;
+ Labels : Label_Array (1 .. N);
+ end record;
+
+ procedure Release_String is
+ new Ada.Unchecked_Deallocation (String,
+ String_Access);
+
+ procedure Release_Environment is
+ new Ada.Unchecked_Deallocation (Key_Environment,
+ Env_Ptr);
+
+ Top_Of_Stack : Env_Ptr := null;
+
+ procedure Push_Environment (Key : in String;
+ Reset : in Boolean := True)
+ is
+ P : constant Env_Ptr := new Key_Environment (Number_Of_Keys);
+ begin
+ -- Store the current labels in the environment
+ for I in 1 .. Number_Of_Keys loop
+ Get_Soft_Label_Key (I, P.Labels (I));
+ if Reset then
+ Set_Soft_Label_Key (I, " ");
+ end if;
+ end loop;
+ P.Prev := Top_Of_Stack;
+ -- now store active help context and notepad
+ P.Help := Active_Context;
+ P.Notepad := Active_Notepad;
+ -- The notepad must now vanish and the new notepad is empty.
+ if P.Notepad /= Null_Panel then
+ Hide (P.Notepad);
+ Update_Panels;
+ end if;
+ Active_Notepad := Null_Panel;
+ Active_Context := new String'(Key);
+
+ Top_Of_Stack := P;
+ if Reset then
+ Refresh_Soft_Label_Keys_Without_Update;
+ end if;
+ end Push_Environment;
+
+ procedure Pop_Environment
+ is
+ P : Env_Ptr := Top_Of_Stack;
+ begin
+ if Top_Of_Stack = null then
+ raise Function_Key_Stack_Error;
+ else
+ for I in 1 .. Number_Of_Keys loop
+ Set_Soft_Label_Key (I, P.Labels (I), Justification);
+ end loop;
+ pragma Assert (Active_Context /= null);
+ Release_String (Active_Context);
+ Active_Context := P.Help;
+ Refresh_Soft_Label_Keys_Without_Update;
+ Notepad_To_Context (P.Notepad);
+ Top_Of_Stack := P.Prev;
+ Release_Environment (P);
+ end if;
+ end Pop_Environment;
+
+ function Context return String
+ is
+ begin
+ if Active_Context /= null then
+ return Active_Context.all;
+ else
+ return "";
+ end if;
+ end Context;
+
+ function Find_Context (Key : String) return Boolean
+ is
+ P : Env_Ptr := Top_Of_Stack;
+ begin
+ if Active_Context.all = Key then
+ return True;
+ else
+ loop
+ exit when P = null;
+ if P.Help.all = Key then
+ return True;
+ else
+ P := P.Prev;
+ end if;
+ end loop;
+ return False;
+ end if;
+ end Find_Context;
+
+ procedure Notepad_To_Context (Pan : in Panel)
+ is
+ W : Window;
+ begin
+ if Active_Notepad /= Null_Panel then
+ W := Get_Window (Active_Notepad);
+ Clear (W);
+ Delete (Active_Notepad);
+ Delete (W);
+ end if;
+ Active_Notepad := Pan;
+ if Pan /= Null_Panel then
+ Top (Pan);
+ end if;
+ Update_Panels;
+ Update_Screen;
+ end Notepad_To_Context;
+
+ procedure Initialize (Mode : Soft_Label_Key_Format := PC_Style;
+ Just : Label_Justification := Left)
+ is
+ begin
+ case Mode is
+ when PC_Style .. PC_Style_With_Index
+ => Number_Of_Keys := 12;
+ when others
+ => Number_Of_Keys := 8;
+ end case;
+ Init_Soft_Label_Keys (Mode);
+ Justification := Just;
+ end Initialize;
+
+ procedure Default_Labels
+ is
+ begin
+ Set_Soft_Label_Key (FKEY_QUIT, "Quit");
+ Set_Soft_Label_Key (FKEY_HELP, "Help");
+ Set_Soft_Label_Key (FKEY_EXPLAIN, "Keys");
+ Refresh_Soft_Label_Keys_Without_Update;
+ end Default_Labels;
+
+ function Notepad_Window return Window
+ is
+ begin
+ if Active_Notepad /= Null_Panel then
+ return Get_Window (Active_Notepad);
+ else
+ return Null_Window;
+ end if;
+ end Notepad_Window;
+
+end Sample.Function_Key_Setting;
diff --git a/Ada95/samples/sample-function_key_setting.ads b/Ada95/samples/sample-function_key_setting.ads
new file mode 100644
index 0000000..e20f619
--- /dev/null
+++ b/Ada95/samples/sample-function_key_setting.ads
@@ -0,0 +1,82 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Function_Key_Setting --
+-- --
+-- 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.9 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
+
+-- This package implements a simple stack of function key label environments.
+--
+package Sample.Function_Key_Setting is
+
+ procedure Push_Environment (Key : in String;
+ Reset : in Boolean := True);
+ -- Push the definition of the current function keys on an internal
+ -- stack. If the reset flag is true, all labels are reset while
+ -- pushed, so the new environment can assume a tabula rasa.
+ -- The Key defines the new Help Context associated with the new
+ -- Environment. This saves also the currently active Notepad.
+
+ procedure Pop_Environment;
+ -- Pop the Definitions from the stack and make them the current ones.
+ -- This also restores the Help context and the previous Notepad.
+
+ procedure Initialize (Mode : Soft_Label_Key_Format := PC_Style;
+ Just : Label_Justification := Left);
+ -- Initialize the environment
+
+ function Context return String;
+ -- Return the current context identitfier
+
+ function Find_Context (Key : String) return Boolean;
+ -- Look for a context, return true if it is in the stack,
+ -- false otherwise.
+
+ procedure Notepad_To_Context (Pan : in Panel);
+ -- Add a panel representing a notepad to the current context.
+
+ Function_Key_Stack_Error : exception;
+
+ procedure Default_Labels;
+ -- Set the default labels used in all environments
+
+ function Notepad_Window return Window;
+ -- Return the current notepad window or Null_Window if there is none.
+
+end Sample.Function_Key_Setting;
diff --git a/Ada95/samples/sample-header_handler.adb b/Ada95/samples/sample-header_handler.adb
new file mode 100644
index 0000000..d198d66
--- /dev/null
+++ b/Ada95/samples/sample-header_handler.adb
@@ -0,0 +1,180 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Header_Handler --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2004,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.16 $
+-- $Date: 2006/06/25 14:30:22 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Calendar; use Ada.Calendar;
+with Terminal_Interface.Curses.Text_IO.Integer_IO;
+with Sample.Manifest; use Sample.Manifest;
+
+-- This package handles the painting of the header line of the screen.
+--
+package body Sample.Header_Handler is
+
+ package Int_IO is new
+ Terminal_Interface.Curses.Text_IO.Integer_IO (Integer);
+ use Int_IO;
+
+ Header_Window : Window := Null_Window;
+
+ Display_Hour : Integer := -1; -- hour last displayed
+ Display_Min : Integer := -1; -- minute last displayed
+ Display_Day : Integer := -1; -- day last displayed
+ Display_Month : Integer := -1; -- month last displayed
+
+ -- This is the routine handed over to the curses library to be called
+ -- as initialization routine when ripping of the header lines from
+ -- the screen. This routine must follow C conventions.
+ function Init_Header_Window (Win : Window;
+ Columns : Column_Count) return Integer;
+ pragma Convention (C, Init_Header_Window);
+
+ procedure Internal_Update_Header_Window (Do_Update : in Boolean);
+
+ -- The initialization must be called before Init_Screen. It steals two
+ -- lines from the top of the screen.
+ procedure Init_Header_Handler
+ is
+ begin
+ Rip_Off_Lines (2, Init_Header_Window'Access);
+ end Init_Header_Handler;
+
+ procedure N_Out (N : in Integer);
+
+ -- Emit a two digit number and ensure that a leading zero is generated if
+ -- necessary.
+ procedure N_Out (N : in Integer)
+ is
+ begin
+ if N < 10 then
+ Add (Header_Window, '0');
+ Put (Header_Window, N, 1);
+ else
+ Put (Header_Window, N, 2);
+ end if;
+ end N_Out;
+
+ -- Paint the header window. The input parameter is a flag indicating
+ -- whether or not the screen should be updated physically after painting.
+ procedure Internal_Update_Header_Window (Do_Update : in Boolean)
+ is
+ type Month_Name_Array is
+ array (Month_Number'First .. Month_Number'Last) of String (1 .. 9);
+
+ Month_Names : constant Month_Name_Array :=
+ ("January ",
+ "February ",
+ "March ",
+ "April ",
+ "May ",
+ "June ",
+ "July ",
+ "August ",
+ "September",
+ "October ",
+ "November ",
+ "December ");
+
+ Now : constant Time := Clock;
+ Sec : constant Integer := Integer (Seconds (Now));
+ Hour : constant Integer := Sec / 3600;
+ Minute : constant Integer := (Sec - Hour * 3600) / 60;
+ Mon : constant Month_Number := Month (Now);
+ D : constant Day_Number := Day (Now);
+ begin
+ if Header_Window /= Null_Window then
+ if Minute /= Display_Min or else Hour /= Display_Hour
+ or else Display_Day /= D or else Display_Month /= Mon then
+ Move_Cursor (Header_Window, 0, 0);
+ N_Out (D); Add (Header_Window, '.');
+ Add (Header_Window, Month_Names (Mon));
+ Move_Cursor (Header_Window, 1, 0);
+ N_Out (Hour); Add (Header_Window, ':');
+ N_Out (Minute);
+ Display_Min := Minute;
+ Display_Hour := Hour;
+ Display_Month := Mon;
+ Display_Day := D;
+ Refresh_Without_Update (Header_Window);
+ if Do_Update then
+ Update_Screen;
+ end if;
+ end if;
+ end if;
+ end Internal_Update_Header_Window;
+
+ -- This routine is called in the keyboard input timeout handler. So it will
+ -- periodically update the header line of the screen.
+ procedure Update_Header_Window
+ is
+ begin
+ Internal_Update_Header_Window (True);
+ end Update_Header_Window;
+
+ function Init_Header_Window (Win : Window;
+ Columns : Column_Count) return Integer
+ is
+ Title : constant String := "Ada 95 ncurses Binding Sample";
+ Pos : Column_Position;
+ begin
+ Header_Window := Win;
+ if Win /= Null_Window then
+ if Has_Colors then
+ Set_Background (Win => Win,
+ Ch => (Ch => ' ',
+ Color => Header_Color,
+ Attr => Normal_Video));
+ Set_Character_Attributes (Win => Win,
+ Attr => Normal_Video,
+ Color => Header_Color);
+ Erase (Win);
+ end if;
+ Leave_Cursor_After_Update (Win, True);
+ Pos := Columns - Column_Position (Title'Length);
+ Add (Win, 0, Pos / 2, Title);
+ -- In this phase we must not allow a physical update, because
+ -- ncurses isn´t properly initialized at this point.
+ Internal_Update_Header_Window (False);
+ return 0;
+ else
+ return -1;
+ end if;
+ end Init_Header_Window;
+
+end Sample.Header_Handler;
diff --git a/Ada95/samples/sample-header_handler.ads b/Ada95/samples/sample-header_handler.ads
new file mode 100644
index 0000000..aa0a0c2
--- /dev/null
+++ b/Ada95/samples/sample-header_handler.ads
@@ -0,0 +1,53 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Header_Handler --
+-- --
+-- 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.9 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+
+-- This package handles the painting of the header line of the screen.
+--
+package Sample.Header_Handler is
+
+ procedure Init_Header_Handler;
+ -- Initialize the handler for the headerlines.
+
+ procedure Update_Header_Window;
+ -- Update the information in the header window
+
+end Sample.Header_Handler;
diff --git a/Ada95/samples/sample-helpers.adb b/Ada95/samples/sample-helpers.adb
new file mode 100644
index 0000000..d04853e
--- /dev/null
+++ b/Ada95/samples/sample-helpers.adb
@@ -0,0 +1,68 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Helpers --
+-- --
+-- 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.12 $
+-- $Date: 2008/07/26 18:48:08 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Sample.Explanation; use Sample.Explanation;
+
+-- This package contains some conveniant helper routines used throughout
+-- this example.
+--
+package body Sample.Helpers is
+
+ procedure Window_Title (Win : in Window;
+ Title : in String)
+ is
+ Height : Line_Count;
+ Width : Column_Count;
+ Pos : Column_Position := 0;
+ begin
+ Get_Size (Win, Height, Width);
+ if Title'Length < Width then
+ Pos := (Width - Title'Length) / 2;
+ end if;
+ Add (Win, 0, Pos, Title);
+ end Window_Title;
+
+ procedure Not_Implemented is
+ begin
+ Explain ("NOTIMPL");
+ end Not_Implemented;
+
+end Sample.Helpers;
diff --git a/Ada95/samples/sample-helpers.ads b/Ada95/samples/sample-helpers.ads
new file mode 100644
index 0000000..c1c8e79
--- /dev/null
+++ b/Ada95/samples/sample-helpers.ads
@@ -0,0 +1,54 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Helpers --
+-- --
+-- 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.9 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+
+-- This package contains some conveniant helper routines used throughout
+-- this example.
+--
+package Sample.Helpers is
+
+ procedure Window_Title (Win : in Window;
+ Title : in String);
+ -- Put a title string into the first line of the window
+
+ procedure Not_Implemented;
+
+end Sample.Helpers;
diff --git a/Ada95/samples/sample-keyboard_handler.adb b/Ada95/samples/sample-keyboard_handler.adb
new file mode 100644
index 0000000..fdac054
--- /dev/null
+++ b/Ada95/samples/sample-keyboard_handler.adb
@@ -0,0 +1,194 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Keyboard_Handler --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2004,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
+------------------------------------------------------------------------------
+with Ada.Strings; use Ada.Strings;
+with Ada.Strings.Fixed; use Ada.Strings.Fixed;
+with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
+with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
+with Ada.Characters.Handling; use Ada.Characters.Handling;
+
+with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
+with Terminal_Interface.Curses.Forms; use Terminal_Interface.Curses.Forms;
+with Terminal_Interface.Curses.Forms.Field_Types.Enumeration;
+use Terminal_Interface.Curses.Forms.Field_Types.Enumeration;
+
+with Sample.Header_Handler; use Sample.Header_Handler;
+with Sample.Form_Demo.Aux; use Sample.Form_Demo.Aux;
+with Sample.Manifest; use Sample.Manifest;
+with Sample.Form_Demo.Handler;
+
+-- This package contains a centralized keyboard handler used throughout
+-- this example. The handler establishes a timeout mechanism that provides
+-- periodical updates of the common header lines used in this example.
+--
+
+package body Sample.Keyboard_Handler is
+
+ In_Command : Boolean := False;
+
+ function Get_Key (Win : Window := Standard_Window) return Real_Key_Code
+ is
+ K : Real_Key_Code;
+
+ function Command return Real_Key_Code;
+
+ function Command return Real_Key_Code
+ is
+ function My_Driver (F : Form;
+ C : Key_Code;
+ P : Panel) return Boolean;
+ package Fh is new Sample.Form_Demo.Handler (My_Driver);
+
+ type Label_Array is array (Label_Number) of String (1 .. 8);
+
+ Labels : Label_Array;
+
+ FA : Field_Array_Access := new Field_Array'
+ (Make (0, 0, "Command:"),
+ Make (Top => 0, Left => 9, Width => Columns - 11),
+ Null_Field);
+
+ K : Real_Key_Code := Key_None;
+ N : Natural := 0;
+
+ function My_Driver (F : Form;
+ C : Key_Code;
+ P : Panel) return Boolean
+ is
+ Ch : Character;
+ begin
+ if P = Null_Panel then
+ raise Panel_Exception;
+ end if;
+ if C in User_Key_Code'Range and then C = QUIT then
+ if Driver (F, F_Validate_Field) = Form_Ok then
+ K := Key_None;
+ return True;
+ end if;
+ elsif C in Normal_Key_Code'Range then
+ Ch := Character'Val (C);
+ if Ch = LF or else Ch = CR then
+ if Driver (F, F_Validate_Field) = Form_Ok then
+ declare
+ Buffer : String (1 .. Positive (Columns - 11));
+ Cmdc : String (1 .. 8);
+ begin
+ Get_Buffer (Fld => FA (2), Str => Buffer);
+ Trim (Buffer, Left);
+ if Buffer (1) /= ' ' then
+ Cmdc := To_Upper (Buffer (Cmdc'Range));
+ for I in Labels'Range loop
+ if Cmdc = Labels (I) then
+ K := Function_Key_Code
+ (Function_Key_Number (I));
+ exit;
+ end if;
+ end loop;
+ end if;
+ return True;
+ end;
+ end if;
+ end if;
+ end if;
+ return False;
+ end My_Driver;
+
+ begin
+ In_Command := True;
+ for I in Label_Number'Range loop
+ Get_Soft_Label_Key (I, Labels (I));
+ Trim (Labels (I), Left);
+ Translate (Labels (I), Upper_Case_Map);
+ if Labels (I) (1) /= ' ' then
+ N := N + 1;
+ end if;
+ end loop;
+ if N > 0 then -- some labels were really set
+ declare
+ Enum_Info : Enumeration_Info (N);
+ Enum_Field : Enumeration_Field;
+ J : Positive := Enum_Info.Names'First;
+
+ Frm : Form := Create (FA);
+
+ begin
+ for I in Label_Number'Range loop
+ if Labels (I) (1) /= ' ' then
+ Enum_Info.Names (J) := new String'(Labels (I));
+ J := J + 1;
+ end if;
+ end loop;
+ Enum_Field := Create (Enum_Info, True);
+ Set_Field_Type (FA (2), Enum_Field);
+ Set_Background (FA (2), Normal_Video);
+
+ Fh.Drive_Me (Frm, Lines - 3, 0);
+ Delete (Frm);
+ Update_Panels; Update_Screen;
+ end;
+ end if;
+ Free (FA, True);
+ In_Command := False;
+ return K;
+ end Command;
+
+ begin
+ Set_Timeout_Mode (Win, Delayed, 30000);
+ loop
+ K := Get_Keystroke (Win);
+ if K = Key_None then -- a timeout occured
+ Update_Header_Window;
+ elsif K = 3 and then not In_Command then -- CTRL-C
+ K := Command;
+ exit when K /= Key_None;
+ else
+ exit;
+ end if;
+ end loop;
+ return K;
+ end Get_Key;
+
+ procedure Init_Keyboard_Handler is
+ begin
+ null;
+ end Init_Keyboard_Handler;
+
+end Sample.Keyboard_Handler;
diff --git a/Ada95/samples/sample-keyboard_handler.ads b/Ada95/samples/sample-keyboard_handler.ads
new file mode 100644
index 0000000..ac5b139
--- /dev/null
+++ b/Ada95/samples/sample-keyboard_handler.ads
@@ -0,0 +1,55 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Keyboard_Handler --
+-- --
+-- 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.9 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+
+-- This package contains a centralized keyboard handler used throughout
+-- this example. The handler establishes a timeout mechanism that provides
+-- periodical updates of the common header lines used in this example.
+--
+package Sample.Keyboard_Handler is
+
+ function Get_Key (Win : Window := Standard_Window) return Real_Key_Code;
+ -- The central routine for handling keystrokes.
+
+ procedure Init_Keyboard_Handler;
+ -- Initialize the keyboard
+
+end Sample.Keyboard_Handler;
diff --git a/Ada95/samples/sample-manifest.ads b/Ada95/samples/sample-manifest.ads
new file mode 100644
index 0000000..bb76c4c
--- /dev/null
+++ b/Ada95/samples/sample-manifest.ads
@@ -0,0 +1,67 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Manifest --
+-- --
+-- 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.11 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+
+package Sample.Manifest is
+
+ QUIT : constant User_Key_Code := User_Key_Code'First;
+ SELECT_ITEM : constant User_Key_Code := QUIT + 1;
+
+ FKEY_HELP : constant Label_Number := 1;
+ HELP_CODE : constant Special_Key_Code := Key_F1;
+ FKEY_EXPLAIN : constant Label_Number := 2;
+ EXPLAIN_CODE : constant Special_Key_Code := Key_F2;
+ FKEY_QUIT : constant Label_Number := 3;
+ QUIT_CODE : constant Special_Key_Code := Key_F3;
+
+ Menu_Marker : constant String := "=> ";
+
+ Default_Colors : constant Redefinable_Color_Pair := 1;
+ Menu_Fore_Color : constant Redefinable_Color_Pair := 2;
+ Menu_Back_Color : constant Redefinable_Color_Pair := 3;
+ Menu_Grey_Color : constant Redefinable_Color_Pair := 4;
+ Form_Fore_Color : constant Redefinable_Color_Pair := 5;
+ Form_Back_Color : constant Redefinable_Color_Pair := 6;
+ Notepad_Color : constant Redefinable_Color_Pair := 7;
+ Help_Color : constant Redefinable_Color_Pair := 8;
+ Header_Color : constant Redefinable_Color_Pair := 9;
+
+end Sample.Manifest;
diff --git a/Ada95/samples/sample-menu_demo-aux.adb b/Ada95/samples/sample-menu_demo-aux.adb
new file mode 100644
index 0000000..b9b237c
--- /dev/null
+++ b/Ada95/samples/sample-menu_demo-aux.adb
@@ -0,0 +1,204 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Menu_Demo.Aux --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- 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.13 $
+-- $Date: 2006/06/25 14:30:22 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
+
+with Sample.Manifest; use Sample.Manifest;
+with Sample.Helpers; use Sample.Helpers;
+with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
+with Sample.Explanation; use Sample.Explanation;
+
+package body Sample.Menu_Demo.Aux is
+
+ procedure Geometry (M : in Menu;
+ L : out Line_Count;
+ C : out Column_Count;
+ Y : out Line_Position;
+ X : out Column_Position;
+ Fy : out Line_Position;
+ Fx : out Column_Position);
+
+ procedure Geometry (M : in Menu;
+ L : out Line_Count; -- Lines used for menu
+ C : out Column_Count; -- Columns used for menu
+ Y : out Line_Position; -- Proposed Line for menu
+ X : out Column_Position; -- Proposed Column for menu
+ Fy : out Line_Position; -- Vertical inner frame
+ Fx : out Column_Position) -- Horiz. inner frame
+ is
+ Spc_Desc : Column_Position; -- spaces between description and item
+ begin
+ Set_Mark (M, Menu_Marker);
+
+ Spacing (M, Spc_Desc, Fy, Fx);
+ Scale (M, L, C);
+
+ Fx := Fx + Column_Position (Fy - 1); -- looks a bit nicer
+
+ L := L + 2 * Fy; -- count for frame at top and bottom
+ C := C + 2 * Fx; -- "
+
+ -- Calculate horizontal coordinate at the screen center
+ X := (Columns - C) / 2;
+ Y := 1; -- always startin line 1
+
+ end Geometry;
+
+ procedure Geometry (M : in Menu;
+ L : out Line_Count; -- Lines used for menu
+ C : out Column_Count; -- Columns used for menu
+ Y : out Line_Position; -- Proposed Line for menu
+ X : out Column_Position) -- Proposed Column for menu
+ is
+ Fy : Line_Position;
+ Fx : Column_Position;
+ begin
+ Geometry (M, L, C, Y, X, Fy, Fx);
+ end Geometry;
+
+ function Create (M : Menu;
+ Title : String;
+ Lin : Line_Position;
+ Col : Column_Position) return Panel
+ is
+ W, S : Window;
+ L : Line_Count;
+ C : Column_Count;
+ Y, Fy : Line_Position;
+ X, Fx : Column_Position;
+ Pan : Panel;
+ begin
+ Geometry (M, L, C, Y, X, Fy, Fx);
+ W := New_Window (L, C, Lin, Col);
+ Set_Meta_Mode (W);
+ Set_KeyPad_Mode (W);
+ if Has_Colors then
+ Set_Background (Win => W,
+ Ch => (Ch => ' ',
+ Color => Menu_Back_Color,
+ Attr => Normal_Video));
+ Set_Foreground (Men => M, Color => Menu_Fore_Color);
+ Set_Background (Men => M, Color => Menu_Back_Color);
+ Set_Grey (Men => M, Color => Menu_Grey_Color);
+ Erase (W);
+ end if;
+ S := Derived_Window (W, L - Fy, C - Fx, Fy, Fx);
+ Set_Meta_Mode (S);
+ Set_KeyPad_Mode (S);
+ Box (W);
+ Set_Window (M, W);
+ Set_Sub_Window (M, S);
+ if Title'Length > 0 then
+ Window_Title (W, Title);
+ end if;
+ Pan := New_Panel (W);
+ Post (M);
+ return Pan;
+ end Create;
+
+ procedure Destroy (M : in Menu;
+ P : in out Panel)
+ is
+ W, S : Window;
+ begin
+ W := Get_Window (M);
+ S := Get_Sub_Window (M);
+ Post (M, False);
+ Erase (W);
+ Delete (P);
+ Set_Window (M, Null_Window);
+ Set_Sub_Window (M, Null_Window);
+ Delete (S);
+ Delete (W);
+ Update_Panels;
+ end Destroy;
+
+ function Get_Request (M : Menu; P : Panel) return Key_Code
+ is
+ W : constant Window := Get_Window (M);
+ K : Real_Key_Code;
+ Ch : Character;
+ begin
+ Top (P);
+ loop
+ K := Get_Key (W);
+ if K in Special_Key_Code'Range then
+ case K is
+ when HELP_CODE => Explain_Context;
+ when EXPLAIN_CODE => Explain ("MENUKEYS");
+ when Key_Home => return REQ_FIRST_ITEM;
+ when QUIT_CODE => return QUIT;
+ when Key_Cursor_Down => return REQ_DOWN_ITEM;
+ when Key_Cursor_Up => return REQ_UP_ITEM;
+ when Key_Cursor_Left => return REQ_LEFT_ITEM;
+ when Key_Cursor_Right => return REQ_RIGHT_ITEM;
+ when Key_End => return REQ_LAST_ITEM;
+ when Key_Backspace => return REQ_BACK_PATTERN;
+ when Key_Next_Page => return REQ_SCR_DPAGE;
+ when Key_Previous_Page => return REQ_SCR_UPAGE;
+ when others => return K;
+ end case;
+ elsif K in Normal_Key_Code'Range then
+ Ch := Character'Val (K);
+ case Ch is
+ when CAN => return QUIT; -- CTRL-X
+ when SO => return REQ_NEXT_ITEM; -- CTRL-N
+ when DLE => return REQ_PREV_ITEM; -- CTRL-P
+ when NAK => return REQ_SCR_ULINE; -- CTRL-U
+ when EOT => return REQ_SCR_DLINE; -- CTRL-D
+ when ACK => return REQ_SCR_DPAGE; -- CTRL-F
+ when STX => return REQ_SCR_UPAGE; -- CTRL-B
+ when EM => return REQ_CLEAR_PATTERN; -- CTRL-Y
+ when BS => return REQ_BACK_PATTERN; -- CTRL-H
+ when SOH => return REQ_NEXT_MATCH; -- CTRL-A
+ when ENQ => return REQ_PREV_MATCH; -- CTRL-E
+ when DC4 => return REQ_TOGGLE_ITEM; -- CTRL-T
+
+ when CR | LF => return SELECT_ITEM;
+ when others => return K;
+ end case;
+ else
+ return K;
+ end if;
+ end loop;
+ end Get_Request;
+
+end Sample.Menu_Demo.Aux;
diff --git a/Ada95/samples/sample-menu_demo-aux.ads b/Ada95/samples/sample-menu_demo-aux.ads
new file mode 100644
index 0000000..964e38e
--- /dev/null
+++ b/Ada95/samples/sample-menu_demo-aux.ads
@@ -0,0 +1,71 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Menu_Demo.Aux --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control
+-- $Revision: 1.9 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
+with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus;
+
+package Sample.Menu_Demo.Aux is
+
+ procedure Geometry (M : in Menu;
+ L : out Line_Count;
+ C : out Column_Count;
+ Y : out Line_Position;
+ X : out Column_Position);
+ -- Calculate the geometry for a panel beeing able to be used to display
+ -- the menu.
+
+ function Create (M : Menu;
+ Title : String;
+ Lin : Line_Position;
+ Col : Column_Position) return Panel;
+ -- Create a panel decorated with a frame and the title at the specified
+ -- position. The dimension of the panel is derived from the menus layout.
+
+ procedure Destroy (M : in Menu;
+ P : in out Panel);
+ -- Destroy all the windowing structures associated with this menu and
+ -- panel.
+
+ function Get_Request (M : Menu; P : Panel) return Key_Code;
+ -- Centralized request driver for all menus in this sample. This
+ -- gives us a common key binding for all menus.
+
+end Sample.Menu_Demo.Aux;
diff --git a/Ada95/samples/sample-menu_demo-handler.adb b/Ada95/samples/sample-menu_demo-handler.adb
new file mode 100644
index 0000000..18747e9
--- /dev/null
+++ b/Ada95/samples/sample-menu_demo-handler.adb
@@ -0,0 +1,108 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Menu_Demo.Handler --
+-- --
+-- 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.15 $
+-- $Date: 2004/08/21 21:37:00 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Sample.Menu_Demo.Aux;
+with Sample.Manifest; use Sample.Manifest;
+with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
+
+package body Sample.Menu_Demo.Handler is
+
+ package Aux renames Sample.Menu_Demo.Aux;
+
+ procedure Drive_Me (M : in Menu;
+ Title : in String := "")
+ is
+ L : Line_Count;
+ C : Column_Count;
+ Y : Line_Position;
+ X : Column_Position;
+ begin
+ Aux.Geometry (M, L, C, Y, X);
+ Drive_Me (M, Y, X, Title);
+ end Drive_Me;
+
+ procedure Drive_Me (M : in Menu;
+ Lin : in Line_Position;
+ Col : in Column_Position;
+ Title : in String := "")
+ is
+ Mask : Event_Mask := No_Events;
+ Old : Event_Mask;
+ Pan : Panel := Aux.Create (M, Title, Lin, Col);
+ V : Cursor_Visibility := Invisible;
+ begin
+ -- We are only interested in Clicks with the left button
+ Register_Reportable_Events (Left, All_Clicks, Mask);
+ Old := Start_Mouse (Mask);
+ Set_Cursor_Visibility (V);
+ loop
+ declare
+ K : Key_Code := Aux.Get_Request (M, Pan);
+ R : constant Driver_Result := Driver (M, K);
+ begin
+ case R is
+ when Menu_Ok => null;
+ when Unknown_Request =>
+ declare
+ I : constant Item := Current (M);
+ O : Item_Option_Set;
+ begin
+ if K = Key_Mouse then
+ K := SELECT_ITEM;
+ end if;
+ Get_Options (I, O);
+ if K = SELECT_ITEM and then not O.Selectable then
+ Beep;
+ else
+ if My_Driver (M, K, Pan) then
+ exit;
+ end if;
+ end if;
+ end;
+ when others => Beep;
+ end case;
+ end;
+ end loop;
+ End_Mouse (Old);
+ Aux.Destroy (M, Pan);
+ end Drive_Me;
+
+end Sample.Menu_Demo.Handler;
diff --git a/Ada95/samples/sample-menu_demo-handler.ads b/Ada95/samples/sample-menu_demo-handler.ads
new file mode 100644
index 0000000..1a82f9f
--- /dev/null
+++ b/Ada95/samples/sample-menu_demo-handler.ads
@@ -0,0 +1,64 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Menu_Demo.Handler --
+-- --
+-- 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.9 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses;
+use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Panels;
+use Terminal_Interface.Curses.Panels;
+with Terminal_Interface.Curses.Menus;
+use Terminal_Interface.Curses.Menus;
+
+generic
+ with function My_Driver (Men : Menu;
+ K : Key_Code;
+ Pan : Panel) return Boolean;
+package Sample.Menu_Demo.Handler is
+
+ procedure Drive_Me (M : in Menu;
+ Lin : in Line_Position;
+ Col : in Column_Position;
+ Title : in String := "");
+ -- Position the menu at the given point and drive it.
+
+ procedure Drive_Me (M : in Menu;
+ Title : in String := "");
+ -- Center menu and drive it.
+
+end Sample.Menu_Demo.Handler;
diff --git a/Ada95/samples/sample-menu_demo.adb b/Ada95/samples/sample-menu_demo.adb
new file mode 100644
index 0000000..3864674
--- /dev/null
+++ b/Ada95/samples/sample-menu_demo.adb
@@ -0,0 +1,396 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Menu_Demo --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2004,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.18 $
+-- $Date: 2008/07/26 18:48:30 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
+with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus;
+with Terminal_Interface.Curses.Menus.Menu_User_Data;
+with Terminal_Interface.Curses.Menus.Item_User_Data;
+
+with Sample.Manifest; use Sample.Manifest;
+with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
+with Sample.Menu_Demo.Handler;
+with Sample.Helpers; use Sample.Helpers;
+with Sample.Explanation; use Sample.Explanation;
+
+package body Sample.Menu_Demo is
+
+ package Spacing_Demo is
+ procedure Spacing_Test;
+ end Spacing_Demo;
+
+ package body Spacing_Demo is
+
+ procedure Spacing_Test
+ is
+ function My_Driver (M : Menu;
+ K : Key_Code;
+ P : Panel) return Boolean;
+
+ procedure Set_Option_Key;
+ procedure Set_Select_Key;
+ procedure Set_Description_Key;
+ procedure Set_Hide_Key;
+
+ package Mh is new Sample.Menu_Demo.Handler (My_Driver);
+
+ I : Item_Array_Access := new Item_Array'
+ (New_Item ("January", "31 Days"),
+ New_Item ("February", "28/29 Days"),
+ New_Item ("March", "31 Days"),
+ New_Item ("April", "30 Days"),
+ New_Item ("May", "31 Days"),
+ New_Item ("June", "30 Days"),
+ New_Item ("July", "31 Days"),
+ New_Item ("August", "31 Days"),
+ New_Item ("September", "30 Days"),
+ New_Item ("October", "31 Days"),
+ New_Item ("November", "30 Days"),
+ New_Item ("December", "31 Days"),
+ Null_Item);
+
+ M : Menu := New_Menu (I);
+ Flip_State : Boolean := True;
+ Hide_Long : Boolean := False;
+
+ type Format_Code is (Four_By_1, Four_By_2, Four_By_3);
+ type Operations is (Flip, Reorder, Reformat, Reselect, Describe);
+
+ type Change is array (Operations) of Boolean;
+ pragma Pack (Change);
+ No_Change : constant Change := Change'(others => False);
+
+ Current_Format : Format_Code := Four_By_1;
+ To_Change : Change := No_Change;
+
+ function My_Driver (M : Menu;
+ K : Key_Code;
+ P : Panel) return Boolean
+ is
+ begin
+ if M = Null_Menu then
+ raise Menu_Exception;
+ end if;
+ if P = Null_Panel then
+ raise Panel_Exception;
+ end if;
+ To_Change := No_Change;
+ if K in User_Key_Code'Range then
+ if K = QUIT then
+ return True;
+ end if;
+ end if;
+ if K in Special_Key_Code'Range then
+ case K is
+ when Key_F4 =>
+ To_Change (Flip) := True;
+ return True;
+ when Key_F5 =>
+ To_Change (Reformat) := True;
+ Current_Format := Four_By_1;
+ return True;
+ when Key_F6 =>
+ To_Change (Reformat) := True;
+ Current_Format := Four_By_2;
+ return True;
+ when Key_F7 =>
+ To_Change (Reformat) := True;
+ Current_Format := Four_By_3;
+ return True;
+ when Key_F8 =>
+ To_Change (Reorder) := True;
+ return True;
+ when Key_F9 =>
+ To_Change (Reselect) := True;
+ return True;
+ when Key_F10 =>
+ if Current_Format /= Four_By_3 then
+ To_Change (Describe) := True;
+ return True;
+ else
+ return False;
+ end if;
+ when Key_F11 =>
+ Hide_Long := not Hide_Long;
+ declare
+ O : Item_Option_Set;
+ begin
+ for J in I'Range loop
+ Get_Options (I (J), O);
+ O.Selectable := True;
+ if Hide_Long then
+ case J is
+ when 1 | 3 | 5 | 7 | 8 | 10 | 12 =>
+ O.Selectable := False;
+ when others => null;
+ end case;
+ end if;
+ Set_Options (I (J), O);
+ end loop;
+ end;
+ return False;
+ when others => null;
+ end case;
+ end if;
+ return False;
+ end My_Driver;
+
+ procedure Set_Option_Key
+ is
+ O : Menu_Option_Set;
+ begin
+ if Current_Format = Four_By_1 then
+ Set_Soft_Label_Key (8, "");
+ else
+ Get_Options (M, O);
+ if O.Row_Major_Order then
+ Set_Soft_Label_Key (8, "O-Col");
+ else
+ Set_Soft_Label_Key (8, "O-Row");
+ end if;
+ end if;
+ Refresh_Soft_Label_Keys_Without_Update;
+ end Set_Option_Key;
+
+ procedure Set_Select_Key
+ is
+ O : Menu_Option_Set;
+ begin
+ Get_Options (M, O);
+ if O.One_Valued then
+ Set_Soft_Label_Key (9, "Multi");
+ else
+ Set_Soft_Label_Key (9, "Singl");
+ end if;
+ Refresh_Soft_Label_Keys_Without_Update;
+ end Set_Select_Key;
+
+ procedure Set_Description_Key
+ is
+ O : Menu_Option_Set;
+ begin
+ if Current_Format = Four_By_3 then
+ Set_Soft_Label_Key (10, "");
+ else
+ Get_Options (M, O);
+ if O.Show_Descriptions then
+ Set_Soft_Label_Key (10, "-Desc");
+ else
+ Set_Soft_Label_Key (10, "+Desc");
+ end if;
+ end if;
+ Refresh_Soft_Label_Keys_Without_Update;
+ end Set_Description_Key;
+
+ procedure Set_Hide_Key
+ is
+ begin
+ if Hide_Long then
+ Set_Soft_Label_Key (11, "Enab");
+ else
+ Set_Soft_Label_Key (11, "Disab");
+ end if;
+ Refresh_Soft_Label_Keys_Without_Update;
+ end Set_Hide_Key;
+
+ begin
+ Push_Environment ("MENU01");
+ Notepad ("MENU-PAD01");
+ Default_Labels;
+ Set_Soft_Label_Key (4, "Flip");
+ Set_Soft_Label_Key (5, "4x1");
+ Set_Soft_Label_Key (6, "4x2");
+ Set_Soft_Label_Key (7, "4x3");
+ Set_Option_Key;
+ Set_Select_Key;
+ Set_Description_Key;
+ Set_Hide_Key;
+
+ Set_Format (M, 4, 1);
+ loop
+ Mh.Drive_Me (M);
+ exit when To_Change = No_Change;
+ if To_Change (Flip) then
+ if Flip_State then
+ Flip_State := False;
+ Set_Spacing (M, 3, 2, 0);
+ else
+ Flip_State := True;
+ Set_Spacing (M);
+ end if;
+ elsif To_Change (Reformat) then
+ case Current_Format is
+ when Four_By_1 => Set_Format (M, 4, 1);
+ when Four_By_2 => Set_Format (M, 4, 2);
+ when Four_By_3 =>
+ declare
+ O : Menu_Option_Set;
+ begin
+ Get_Options (M, O);
+ O.Show_Descriptions := False;
+ Set_Options (M, O);
+ Set_Format (M, 4, 3);
+ end;
+ end case;
+ Set_Option_Key;
+ Set_Description_Key;
+ elsif To_Change (Reorder) then
+ declare
+ O : Menu_Option_Set;
+ begin
+ Get_Options (M, O);
+ O.Row_Major_Order := not O.Row_Major_Order;
+ Set_Options (M, O);
+ Set_Option_Key;
+ end;
+ elsif To_Change (Reselect) then
+ declare
+ O : Menu_Option_Set;
+ begin
+ Get_Options (M, O);
+ O.One_Valued := not O.One_Valued;
+ Set_Options (M, O);
+ Set_Select_Key;
+ end;
+ elsif To_Change (Describe) then
+ declare
+ O : Menu_Option_Set;
+ begin
+ Get_Options (M, O);
+ O.Show_Descriptions := not O.Show_Descriptions;
+ Set_Options (M, O);
+ Set_Description_Key;
+ end;
+ else
+ null;
+ end if;
+ end loop;
+ Set_Spacing (M);
+
+ Pop_Environment;
+ pragma Assert (Get_Index (Items (M, 1)) = Get_Index (I (1)));
+ Delete (M);
+ Free (I, True);
+ end Spacing_Test;
+ end Spacing_Demo;
+
+ procedure Demo
+ is
+ -- We use this datatype only to test the instantiation of
+ -- the Menu_User_Data generic package. No functionality
+ -- behind it.
+ type User_Data is new Integer;
+ type User_Data_Access is access User_Data;
+
+ -- Those packages are only instantiated to test the usability.
+ -- No real functionality is shown in the demo.
+ package MUD is new Menu_User_Data (User_Data, User_Data_Access);
+ package IUD is new Item_User_Data (User_Data, User_Data_Access);
+
+ function My_Driver (M : Menu;
+ K : Key_Code;
+ P : Panel) return Boolean;
+
+ package Mh is new Sample.Menu_Demo.Handler (My_Driver);
+
+ Itm : Item_Array_Access := new Item_Array'
+ (New_Item ("Menu Layout Options"),
+ New_Item ("Demo of Hook functions"),
+ Null_Item);
+ M : Menu := New_Menu (Itm);
+
+ U1 : constant User_Data_Access := new User_Data'(4711);
+ U2 : User_Data_Access;
+ U3 : constant User_Data_Access := new User_Data'(4712);
+ U4 : User_Data_Access;
+
+ function My_Driver (M : Menu;
+ K : Key_Code;
+ P : Panel) return Boolean
+ is
+ Idx : constant Positive := Get_Index (Current (M));
+ begin
+ if K in User_Key_Code'Range then
+ if K = QUIT then
+ return True;
+ elsif K = SELECT_ITEM then
+ if Idx in Itm'Range then
+ Hide (P);
+ Update_Panels;
+ end if;
+ case Idx is
+ when 1 => Spacing_Demo.Spacing_Test;
+ when others => Not_Implemented;
+ end case;
+ if Idx in Itm'Range then
+ Top (P);
+ Show (P);
+ Update_Panels;
+ Update_Screen;
+ end if;
+ end if;
+ end if;
+ return False;
+ end My_Driver;
+ begin
+ Push_Environment ("MENU00");
+ Notepad ("MENU-PAD00");
+ Default_Labels;
+ Refresh_Soft_Label_Keys_Without_Update;
+ Set_Pad_Character (M, '|');
+
+ MUD.Set_User_Data (M, U1);
+ IUD.Set_User_Data (Itm (1), U3);
+
+ Mh.Drive_Me (M);
+
+ MUD.Get_User_Data (M, U2);
+ pragma Assert (U1 = U2 and U1.all = 4711);
+
+ IUD.Get_User_Data (Itm (1), U4);
+ pragma Assert (U3 = U4 and U3.all = 4712);
+
+ Pop_Environment;
+ Delete (M);
+ Free (Itm, True);
+ end Demo;
+
+end Sample.Menu_Demo;
diff --git a/Ada95/samples/sample-menu_demo.ads b/Ada95/samples/sample-menu_demo.ads
new file mode 100644
index 0000000..b071afc
--- /dev/null
+++ b/Ada95/samples/sample-menu_demo.ads
@@ -0,0 +1,45 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Menu_Demo --
+-- --
+-- 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.9 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package Sample.Menu_Demo is
+
+ procedure Demo;
+
+end Sample.Menu_Demo;
diff --git a/Ada95/samples/sample-my_field_type.adb b/Ada95/samples/sample-my_field_type.adb
new file mode 100644
index 0000000..e0d6f67
--- /dev/null
+++ b/Ada95/samples/sample-my_field_type.adb
@@ -0,0 +1,68 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.My_Field_Type --
+-- --
+-- 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.16 $
+-- $Date: 2008/07/26 18:47:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+
+-- This is a very simple user defined field type. It accepts only a
+-- defined character as input into the field.
+--
+package body Sample.My_Field_Type is
+
+ -- That's simple. There are minimal field validity checks.
+ function Field_Check (Fld : Field;
+ Typ : My_Data) return Boolean
+ is
+ begin
+ if Fld = Null_Field or Typ.Ch = Character'Val (0) then
+ return False;
+ end if;
+ return True;
+ end Field_Check;
+
+ -- Check exactly against the specified character.
+ function Character_Check (Ch : Character;
+ Typ : My_Data) return Boolean
+ is
+ C : constant Character := Typ.Ch;
+ begin
+ return Ch = C;
+ end Character_Check;
+
+end Sample.My_Field_Type;
diff --git a/Ada95/samples/sample-my_field_type.ads b/Ada95/samples/sample-my_field_type.ads
new file mode 100644
index 0000000..b8f3653
--- /dev/null
+++ b/Ada95/samples/sample-my_field_type.ads
@@ -0,0 +1,61 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.My_Field_Type --
+-- --
+-- 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.12 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses.Forms; use Terminal_Interface.Curses.Forms;
+with Terminal_Interface.Curses.Forms.Field_Types.User;
+use Terminal_Interface.Curses.Forms.Field_Types.User;
+
+-- This is a very simple user defined field type. It accepts only a
+-- defined character as input into the field.
+--
+package Sample.My_Field_Type is
+
+ type My_Data is new User_Defined_Field_Type with
+ record
+ Ch : Character;
+ end record;
+
+ function Field_Check (Fld : Field;
+ Typ : My_Data) return Boolean;
+
+ function Character_Check (Ch : Character;
+ Typ : My_Data) return Boolean;
+
+end Sample.My_Field_Type;
diff --git a/Ada95/samples/sample-text_io_demo.adb b/Ada95/samples/sample-text_io_demo.adb
new file mode 100644
index 0000000..0b385c4
--- /dev/null
+++ b/Ada95/samples/sample-text_io_demo.adb
@@ -0,0 +1,181 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Text_IO_Demo --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2004,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.16 $
+-- $Date: 2006/06/25 14:30:22 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Numerics.Generic_Elementary_Functions;
+with Ada.Numerics.Complex_Types;
+use Ada.Numerics.Complex_Types;
+
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
+with Terminal_Interface.Curses.Text_IO;
+use Terminal_Interface.Curses.Text_IO;
+with Terminal_Interface.Curses.Text_IO.Integer_IO;
+with Terminal_Interface.Curses.Text_IO.Float_IO;
+with Terminal_Interface.Curses.Text_IO.Enumeration_IO;
+with Terminal_Interface.Curses.Text_IO.Complex_IO;
+with Terminal_Interface.Curses.Text_IO.Fixed_IO;
+with Terminal_Interface.Curses.Text_IO.Decimal_IO;
+with Terminal_Interface.Curses.Text_IO.Modular_IO;
+
+with Sample.Manifest; use Sample.Manifest;
+with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
+with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
+with Sample.Explanation; use Sample.Explanation;
+
+package body Sample.Text_IO_Demo is
+
+ type Weekday is (Sunday,
+ Monday,
+ Tuesday,
+ Wednesday,
+ Thursday,
+ Friday,
+ Saturday);
+
+ type Fix is delta 0.1 range 0.0 .. 4.0;
+ type Dec is delta 0.01 digits 5 range 0.0 .. 4.0;
+ type Md is mod 5;
+
+ package Math is new
+ Ada.Numerics.Generic_Elementary_Functions (Float);
+
+ package Int_IO is new
+ Terminal_Interface.Curses.Text_IO.Integer_IO (Integer);
+ use Int_IO;
+
+ package Real_IO is new
+ Terminal_Interface.Curses.Text_IO.Float_IO (Float);
+ use Real_IO;
+
+ package Enum_IO is new
+ Terminal_Interface.Curses.Text_IO.Enumeration_IO (Weekday);
+ use Enum_IO;
+
+ package C_IO is new
+ Terminal_Interface.Curses.Text_IO.Complex_IO (Ada.Numerics.Complex_Types);
+ use C_IO;
+
+ package F_IO is new
+ Terminal_Interface.Curses.Text_IO.Fixed_IO (Fix);
+ use F_IO;
+
+ package D_IO is new
+ Terminal_Interface.Curses.Text_IO.Decimal_IO (Dec);
+ use D_IO;
+
+ package M_IO is new
+ Terminal_Interface.Curses.Text_IO.Modular_IO (Md);
+ use M_IO;
+
+ procedure Demo
+ is
+ W : Window;
+ P : Panel := Create (Standard_Window);
+ K : Real_Key_Code;
+ Im : constant Complex := (0.0, 1.0);
+ Fx : constant Dec := 3.14;
+ Dc : constant Dec := 2.72;
+ L : Md;
+
+ begin
+ Push_Environment ("TEXTIO");
+ Default_Labels;
+ Notepad ("TEXTIO-PAD00");
+
+ Set_Echo_Mode (False);
+ Set_Meta_Mode;
+ Set_KeyPad_Mode;
+ W := Sub_Window (Standard_Window, Lines - 2, Columns - 2, 1, 1);
+ Box;
+ Refresh_Without_Update;
+ Set_Meta_Mode (W);
+ Set_KeyPad_Mode (W);
+ Immediate_Update_Mode (W, True);
+
+ Set_Window (W);
+
+ for I in 1 .. 10 loop
+ Put ("Square root of ");
+ Put (Item => I, Width => 5);
+ Put (" is ");
+ Put (Item => Math.Sqrt (Float (I)), Exp => 0, Aft => 7);
+ New_Line;
+ end loop;
+
+ for W in Weekday loop
+ Put (Item => W); Put (' ');
+ end loop;
+ New_Line;
+
+ L := Md'First;
+ for I in 1 .. 2 loop
+ for J in Md'Range loop
+ Put (L); Put (' ');
+ L := L + 1;
+ end loop;
+ end loop;
+ New_Line;
+
+ Put (Im); New_Line;
+ Put (Fx); New_Line;
+ Put (Dc); New_Line;
+
+ loop
+ K := Get_Key;
+ if K in Special_Key_Code'Range then
+ case K is
+ when QUIT_CODE => exit;
+ when HELP_CODE => Explain_Context;
+ when EXPLAIN_CODE => Explain ("TEXTIOKEYS");
+ when others => null;
+ end case;
+ end if;
+ end loop;
+
+ Set_Window (Null_Window);
+ Erase; Refresh_Without_Update;
+ Delete (P);
+ Delete (W);
+
+ Pop_Environment;
+ end Demo;
+
+end Sample.Text_IO_Demo;
diff --git a/Ada95/samples/sample-text_io_demo.ads b/Ada95/samples/sample-text_io_demo.ads
new file mode 100644
index 0000000..d3f5a18
--- /dev/null
+++ b/Ada95/samples/sample-text_io_demo.ads
@@ -0,0 +1,45 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample.Text_IO_Demo --
+-- --
+-- 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.9 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package Sample.Text_IO_Demo is
+
+ procedure Demo;
+
+end Sample.Text_IO_Demo;
diff --git a/Ada95/samples/sample.adb b/Ada95/samples/sample.adb
new file mode 100644
index 0000000..648036f
--- /dev/null
+++ b/Ada95/samples/sample.adb
@@ -0,0 +1,220 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- 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.17 $
+-- $Date: 2008/09/27 14:42:40 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Text_IO;
+
+with Ada.Exceptions; use Ada.Exceptions;
+
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
+with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus;
+with Terminal_Interface.Curses.Menus.Menu_User_Data;
+with Terminal_Interface.Curses.Menus.Item_User_Data;
+
+with Sample.Manifest; use Sample.Manifest;
+with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
+with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
+with Sample.Header_Handler; use Sample.Header_Handler;
+with Sample.Explanation; use Sample.Explanation;
+
+with Sample.Menu_Demo.Handler;
+with Sample.Curses_Demo;
+with Sample.Form_Demo;
+with Sample.Menu_Demo;
+with Sample.Text_IO_Demo;
+
+with GNAT.OS_Lib;
+
+package body Sample is
+
+ type User_Data is
+ record
+ Data : Integer;
+ end record;
+ type User_Access is access User_Data;
+
+ package Ud is new
+ Terminal_Interface.Curses.Menus.Menu_User_Data
+ (User_Data, User_Access);
+
+ package Id is new
+ Terminal_Interface.Curses.Menus.Item_User_Data
+ (User_Data, User_Access);
+
+ procedure Whow is
+ procedure Main_Menu;
+ procedure Main_Menu
+ is
+ function My_Driver (M : Menu;
+ K : Key_Code;
+ Pan : Panel) return Boolean;
+
+ package Mh is new Sample.Menu_Demo.Handler (My_Driver);
+
+ I : Item_Array_Access := new Item_Array'
+ (New_Item ("Curses Core Demo"),
+ New_Item ("Menu Demo"),
+ New_Item ("Form Demo"),
+ New_Item ("Text IO Demo"),
+ Null_Item);
+
+ M : Menu := New_Menu (I);
+
+ D1, D2 : User_Access;
+ I1, I2 : User_Access;
+
+ function My_Driver (M : Menu;
+ K : Key_Code;
+ Pan : Panel) return Boolean
+ is
+ Idx : constant Positive := Get_Index (Current (M));
+ begin
+ if K in User_Key_Code'Range then
+ if K = QUIT then
+ return True;
+ elsif K = SELECT_ITEM then
+ if Idx <= 4 then
+ Hide (Pan);
+ Update_Panels;
+ end if;
+ case Idx is
+ when 1 => Sample.Curses_Demo.Demo;
+ when 2 => Sample.Menu_Demo.Demo;
+ when 3 => Sample.Form_Demo.Demo;
+ when 4 => Sample.Text_IO_Demo.Demo;
+ when others => null;
+ end case;
+ if Idx <= 4 then
+ Top (Pan);
+ Show (Pan);
+ Update_Panels;
+ Update_Screen;
+ end if;
+ end if;
+ end if;
+ return False;
+ end My_Driver;
+
+ begin
+
+ if (1 + Item_Count (M)) /= I'Length then
+ raise Constraint_Error;
+ end if;
+
+ D1 := new User_Data'(Data => 4711);
+ Ud.Set_User_Data (M, D1);
+
+ I1 := new User_Data'(Data => 1174);
+ Id.Set_User_Data (I (1), I1);
+
+ Set_Spacing (Men => M, Row => 2);
+
+ Default_Labels;
+ Notepad ("MAINPAD");
+
+ Mh.Drive_Me (M, " Demo ");
+
+ Ud.Get_User_Data (M, D2);
+ pragma Assert (D1 = D2);
+ pragma Assert (D1.Data = D2.Data);
+
+ Id.Get_User_Data (I (1), I2);
+ pragma Assert (I1 = I2);
+ pragma Assert (I1.Data = I2.Data);
+
+ Delete (M);
+ Free (I, True);
+ end Main_Menu;
+
+ begin
+ Initialize (PC_Style_With_Index);
+ Init_Header_Handler;
+ Init_Screen;
+
+ if Has_Colors then
+ Start_Color;
+
+ Init_Pair (Pair => Default_Colors, Fore => Black, Back => White);
+ Init_Pair (Pair => Menu_Back_Color, Fore => Black, Back => Cyan);
+ Init_Pair (Pair => Menu_Fore_Color, Fore => Red, Back => Cyan);
+ Init_Pair (Pair => Menu_Grey_Color, Fore => White, Back => Cyan);
+ Init_Pair (Pair => Notepad_Color, Fore => Black, Back => Yellow);
+ Init_Pair (Pair => Help_Color, Fore => Blue, Back => Cyan);
+ Init_Pair (Pair => Form_Back_Color, Fore => Black, Back => Cyan);
+ Init_Pair (Pair => Form_Fore_Color, Fore => Red, Back => Cyan);
+ Init_Pair (Pair => Header_Color, Fore => Black, Back => Green);
+
+ Set_Background (Ch => (Color => Default_Colors,
+ Attr => Normal_Video,
+ Ch => ' '));
+ Set_Character_Attributes (Attr => Normal_Video,
+ Color => Default_Colors);
+ Erase;
+
+ Set_Soft_Label_Key_Attributes (Color => Header_Color);
+ -- This propagates the attributes to the label window
+ Refresh_Soft_Label_Keys;
+ end if;
+
+ Init_Keyboard_Handler;
+
+ Set_Echo_Mode (False);
+ Set_Raw_Mode;
+ Set_Meta_Mode;
+ Set_KeyPad_Mode;
+
+ -- Initialize the Function Key Environment
+ -- We have some fixed key throughout this sample
+ Main_Menu;
+ End_Windows;
+ Curses_Free_All;
+
+ exception
+ when Event : others =>
+ Terminal_Interface.Curses.End_Windows;
+ Text_IO.Put ("Exception: ");
+ Text_IO.Put (Exception_Name (Event));
+ Text_IO.New_Line;
+ GNAT.OS_Lib.OS_Exit (1);
+
+ end Whow;
+
+end Sample;
diff --git a/Ada95/samples/sample.ads b/Ada95/samples/sample.ads
new file mode 100644
index 0000000..9d0647d
--- /dev/null
+++ b/Ada95/samples/sample.ads
@@ -0,0 +1,43 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Sample --
+-- --
+-- 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.9 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package Sample is
+ procedure Whow;
+end Sample;
diff --git a/Ada95/samples/status.adb b/Ada95/samples/status.adb
new file mode 100644
index 0000000..e658131
--- /dev/null
+++ b/Ada95/samples/status.adb
@@ -0,0 +1,57 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Status --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Laurent Pautet <pautet@gnat.com>
+-- Modified by: Juergen Pfeifer, 1997
+-- Version Control
+-- $Revision: 1.7 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+-- This package has been contributed by Laurent Pautet <pautet@gnat.com> --
+-- --
+package body Status is
+
+ protected body Process is
+ procedure Stop is
+ begin
+ Done := True;
+ end Stop;
+ function Continue return Boolean is
+ begin
+ return not Done;
+ end Continue;
+ end Process;
+
+end Status;
diff --git a/Ada95/samples/status.ads b/Ada95/samples/status.ads
new file mode 100644
index 0000000..e9e3ee8
--- /dev/null
+++ b/Ada95/samples/status.ads
@@ -0,0 +1,60 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Status --
+-- --
+-- 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: Laurent Pautet <pautet@gnat.com>
+-- Modified by: Juergen Pfeifer, 1997
+-- Version Control
+-- $Revision: 1.9 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+-- This package has been contributed by Laurent Pautet <pautet@gnat.com> --
+-- --
+with Ada.Interrupts.Names;
+
+package Status is
+
+ pragma Warnings (Off); -- the next pragma exists since 3.11p
+ pragma Unreserve_All_Interrupts;
+ pragma Warnings (On);
+
+ protected Process is
+ procedure Stop;
+ function Continue return Boolean;
+ pragma Attach_Handler (Stop, Ada.Interrupts.Names.SIGINT);
+ private
+ Done : Boolean := False;
+ end Process;
+
+end Status;
diff --git a/Ada95/samples/tour.adb b/Ada95/samples/tour.adb
new file mode 100644
index 0000000..1cc91c1
--- /dev/null
+++ b/Ada95/samples/tour.adb
@@ -0,0 +1,46 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- tour --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control
+-- $Revision: 1.9 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Sample; use Sample;
+
+procedure Tour is
+begin
+ Whow;
+end Tour;
diff --git a/Ada95/samples/tour.ads b/Ada95/samples/tour.ads
new file mode 100644
index 0000000..8888169
--- /dev/null
+++ b/Ada95/samples/tour.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- Tour --
+-- --
+-- 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.9 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+procedure Tour;
diff --git a/Ada95/src/Makefile.in b/Ada95/src/Makefile.in
new file mode 100644
index 0000000..1c072bf
--- /dev/null
+++ b/Ada95/src/Makefile.in
@@ -0,0 +1,388 @@
+##############################################################################
+# Copyright (c) 1998-2003,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
+#
+# $Id: Makefile.in,v 1.31 2007/09/15 18:22:24 tom Exp $
+#
+.SUFFIXES:
+
+SHELL = /bin/sh
+THIS = Makefile
+
+MODEL = ../../@DFT_OBJ_SUBDIR@
+DESTDIR = @DESTDIR@
+srcdir = @srcdir@
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+ADA_INCLUDE = @ADA_INCLUDE@
+
+INSTALL = @INSTALL@
+INSTALL_DATA = @INSTALL_DATA@
+
+AR = @AR@
+AR_OPTS = @AR_OPTS@
+AWK = @AWK@
+LN_S = @LN_S@
+
+CC = @CC@
+CFLAGS = @CFLAGS@
+
+CPPFLAGS = @ACPPFLAGS@ \
+ -DHAVE_CONFIG_H -I$(srcdir)
+
+CCFLAGS = $(CPPFLAGS) $(CFLAGS)
+
+CFLAGS_NORMAL = $(CCFLAGS)
+CFLAGS_DEBUG = $(CCFLAGS) @CC_G_OPT@ -DTRACE
+CFLAGS_PROFILE = $(CCFLAGS) -pg
+CFLAGS_SHARED = $(CCFLAGS) @CC_SHARED_OPTS@
+
+CFLAGS_DEFAULT = $(CFLAGS_@DFT_UPR_MODEL@)
+
+LINK = $(CC)
+LDFLAGS = @LDFLAGS@ @LD_MODEL@ @LIBS@
+
+RANLIB = @RANLIB@
+################################################################################
+ADA = @cf_ada_compiler@
+ADAPREP = gnatprep
+ADAFLAGS = @ADAFLAGS@ -I. -I$(srcdir)
+
+ADAMAKE = @cf_ada_make@
+ADAMAKEFLAGS =
+
+CARGS = -cargs $(ADAFLAGS)
+LARGS =
+
+ALIB = @cf_ada_package@
+ABASE = $(ALIB)-curses
+
+LIBALIS=$(ALIB).ali \
+ $(ABASE)-aux.ali \
+ $(ABASE).ali \
+ $(ABASE)-terminfo.ali \
+ $(ABASE)-termcap.ali \
+ $(ABASE)-putwin.ali \
+ $(ABASE)-trace.ali \
+ $(ABASE)-mouse.ali \
+ $(ABASE)-panels.ali \
+ $(ABASE)-menus.ali \
+ $(ABASE)-forms.ali \
+ $(ABASE)-forms-field_types.ali \
+ $(ABASE)-forms-field_types-alpha.ali \
+ $(ABASE)-forms-field_types-alphanumeric.ali \
+ $(ABASE)-forms-field_types-intfield.ali \
+ $(ABASE)-forms-field_types-numeric.ali \
+ $(ABASE)-forms-field_types-regexp.ali \
+ $(ABASE)-forms-field_types-enumeration.ali \
+ $(ABASE)-forms-field_types-ipv4_address.ali \
+ $(ABASE)-forms-field_types-user.ali \
+ $(ABASE)-forms-field_types-user-choice.ali \
+ $(ABASE)-text_io.ali \
+ $(ABASE)-text_io-aux.ali
+
+# Ada Library files for generic packages. Since gnat 3.10 they are
+# also compiled
+GENALIS=$(ABASE)-menus-menu_user_data.ali \
+ $(ABASE)-menus-item_user_data.ali \
+ $(ABASE)-forms-form_user_data.ali \
+ $(ABASE)-forms-field_user_data.ali \
+ $(ABASE)-forms-field_types-enumeration-ada.ali \
+ $(ABASE)-panels-user_data.ali \
+ $(ABASE)-text_io-integer_io.ali \
+ $(ABASE)-text_io-float_io.ali \
+ $(ABASE)-text_io-fixed_io.ali \
+ $(ABASE)-text_io-decimal_io.ali \
+ $(ABASE)-text_io-enumeration_io.ali \
+ $(ABASE)-text_io-modular_io.ali \
+ $(ABASE)-text_io-complex_io.ali
+
+LIBOBJS=$(ALIB).o \
+ $(ABASE)-aux.o \
+ $(ABASE).o \
+ $(ABASE)-terminfo.o \
+ $(ABASE)-termcap.o \
+ $(ABASE)-putwin.o \
+ $(ABASE)-trace.o \
+ $(ABASE)-mouse.o \
+ $(ABASE)-panels.o \
+ $(ABASE)-menus.o \
+ $(ABASE)-forms.o \
+ $(ABASE)-forms-field_types.o \
+ $(ABASE)-forms-field_types-alpha.o \
+ $(ABASE)-forms-field_types-alphanumeric.o \
+ $(ABASE)-forms-field_types-intfield.o \
+ $(ABASE)-forms-field_types-numeric.o \
+ $(ABASE)-forms-field_types-regexp.o \
+ $(ABASE)-forms-field_types-enumeration.o \
+ $(ABASE)-forms-field_types-ipv4_address.o \
+ $(ABASE)-forms-field_types-user.o \
+ $(ABASE)-forms-field_types-user-choice.o \
+ $(ABASE)-text_io.o \
+ $(ABASE)-text_io-aux.o
+
+# Ada object files for generic packages. Since gnat 3.10 they are
+# also compiled
+GENOBJS=$(ABASE)-menus-menu_user_data.o \
+ $(ABASE)-menus-item_user_data.o \
+ $(ABASE)-forms-form_user_data.o \
+ $(ABASE)-forms-field_user_data.o \
+ $(ABASE)-forms-field_types-enumeration-ada.o \
+ $(ABASE)-panels-user_data.o \
+ $(ABASE)-text_io-integer_io.o \
+ $(ABASE)-text_io-float_io.o \
+ $(ABASE)-text_io-fixed_io.o \
+ $(ABASE)-text_io-decimal_io.o \
+ $(ABASE)-text_io-enumeration_io.o \
+ $(ABASE)-text_io-modular_io.o \
+ $(ABASE)-text_io-complex_io.o
+
+
+all :: libAdaCurses.a
+ @echo done
+
+libAdaCurses.a :: dotouch $(LIBOBJS) @cf_generic_objects@
+ $(AR) $(AR_OPTS) $@ $(LIBOBJS) @cf_generic_objects@
+
+dotouch :
+ @sh -c 'for f in $(LIBALIS) $(GENALIS); do test -f $$f || touch $$f; done'
+
+sources :
+ @echo made $@
+
+libs \
+install \
+install.libs \
+uninstall \
+uninstall.libs ::
+ @echo made $@
+
+generics: $(GENALIS)
+ @echo made $@
+
+mostlyclean ::
+ rm -f *.o *.ali b_t*.* *.s $(PROGS) a.out core b_*_test.c *.xr[bs] *.a
+
+clean :: mostlyclean
+ rm -f $(LIBALIS) $(GENALIS) $(LIBOBJS) $(GENOBJS) $(ABASE)-trace.adb
+
+distclean :: clean
+ rm -f Makefile
+
+realclean :: distclean
+
+BASEDEPS=$(ABASE).ads $(ABASE)-aux.ads $(ABASE).adb
+
+$(ALIB).o: $(srcdir)/$(ALIB).ads
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ALIB).ads
+
+
+$(ABASE)-aux.o: $(srcdir)/$(ABASE)-aux.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-aux.adb
+
+
+$(ABASE).o: $(ABASE).adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(ABASE).adb
+
+
+$(ABASE)-terminfo.o: \
+ $(srcdir)/$(ABASE)-terminfo.ads \
+ $(srcdir)/$(ABASE)-terminfo.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-terminfo.adb
+
+
+$(ABASE)-termcap.o: \
+ $(srcdir)/$(ABASE)-termcap.ads \
+ $(srcdir)/$(ABASE)-termcap.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-termcap.adb
+
+
+$(ABASE)-putwin.o: \
+ $(srcdir)/$(ABASE)-putwin.ads \
+ $(srcdir)/$(ABASE)-putwin.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-putwin.adb
+
+
+$(ABASE)-trace.adb : $(srcdir)/$(ABASE)-trace.adb_p
+ rm -f $@
+ $(ADAPREP) -DADA_TRACE=@ADA_TRACE@ -DPRAGMA_UNREF=@PRAGMA_UNREF@ $(srcdir)/$(ABASE)-trace.adb_p $@
+
+$(ABASE)-trace.o: \
+ $(ABASE)-trace.ads \
+ $(ABASE)-trace.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(ABASE)-trace.adb
+
+
+$(ABASE)-mouse.o: \
+ $(ABASE)-mouse.ads \
+ $(srcdir)/$(ABASE)-mouse.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-mouse.adb
+
+
+$(ABASE)-panels.o: \
+ $(ABASE)-panels.ads \
+ $(srcdir)/$(ABASE)-panels.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-panels.adb
+
+
+$(ABASE)-menus.o: \
+ $(ABASE)-menus.ads \
+ $(srcdir)/$(ABASE)-menus.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-menus.adb
+
+
+$(ABASE)-forms.o: \
+ $(ABASE)-forms.ads \
+ $(srcdir)/$(ABASE)-forms.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms.adb
+
+$(ABASE)-forms-field_types.o: \
+ $(ABASE)-forms-field_types.ads \
+ $(srcdir)/$(ABASE)-forms-field_types.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types.adb
+
+$(ABASE)-forms-field_types-alpha.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-alpha.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-alpha.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-alpha.adb
+
+$(ABASE)-forms-field_types-alphanumeric.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-alphanumeric.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-alphanumeric.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-alphanumeric.adb
+
+$(ABASE)-forms-field_types-intfield.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-intfield.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-intfield.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-intfield.adb
+
+$(ABASE)-forms-field_types-numeric.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-numeric.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-numeric.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-numeric.adb
+
+$(ABASE)-forms-field_types-regexp.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-regexp.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-regexp.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-regexp.adb
+
+$(ABASE)-forms-field_types-enumeration.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-enumeration.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-enumeration.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-enumeration.adb
+
+$(ABASE)-forms-field_types-ipv4_address.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-ipv4_address.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-ipv4_address.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-ipv4_address.adb
+
+$(ABASE)-forms-field_types-user.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-user.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-user.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-user.adb
+
+$(ABASE)-forms-field_types-user-choice.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-user-choice.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-user-choice.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-user-choice.adb
+
+$(ABASE)-text_io.o: \
+ $(srcdir)/$(ABASE)-text_io.ads \
+ $(srcdir)/$(ABASE)-text_io.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io.adb
+
+$(ABASE)-text_io-aux.o: \
+ $(srcdir)/$(ABASE)-text_io-aux.ads \
+ $(srcdir)/$(ABASE)-text_io-aux.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-aux.adb
+
+$(ABASE)-menus-menu_user_data.o: \
+ $(ABASE)-menus-menu_user_data.ads \
+ $(srcdir)/$(ABASE)-menus-menu_user_data.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-menus-menu_user_data.adb
+
+$(ABASE)-menus-item_user_data.o: \
+ $(ABASE)-menus-item_user_data.ads \
+ $(srcdir)/$(ABASE)-menus-item_user_data.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-menus-item_user_data.adb
+
+$(ABASE)-forms-form_user_data.o: \
+ $(ABASE)-forms-form_user_data.ads \
+ $(srcdir)/$(ABASE)-forms-form_user_data.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-form_user_data.adb
+
+$(ABASE)-forms-field_user_data.o: \
+ $(ABASE)-forms-field_user_data.ads \
+ $(srcdir)/$(ABASE)-forms-field_user_data.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_user_data.adb
+
+$(ABASE)-forms-field_types-enumeration-ada.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-enumeration-ada.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-enumeration-ada.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-enumeration-ada.adb
+
+$(ABASE)-panels-user_data.o: \
+ $(ABASE)-panels-user_data.ads \
+ $(srcdir)/$(ABASE)-panels-user_data.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-panels-user_data.adb
+
+$(ABASE)-text_io-integer_io.o: \
+ $(srcdir)/$(ABASE)-text_io-integer_io.ads \
+ $(srcdir)/$(ABASE)-text_io-integer_io.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-integer_io.adb
+
+$(ABASE)-text_io-float_io.o: \
+ $(srcdir)/$(ABASE)-text_io-float_io.ads \
+ $(srcdir)/$(ABASE)-text_io-float_io.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-float_io.adb
+
+$(ABASE)-text_io-fixed_io.o: \
+ $(srcdir)/$(ABASE)-text_io-fixed_io.ads \
+ $(srcdir)/$(ABASE)-text_io-fixed_io.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-fixed_io.adb
+
+$(ABASE)-text_io-decimal_io.o: \
+ $(srcdir)/$(ABASE)-text_io-decimal_io.ads \
+ $(srcdir)/$(ABASE)-text_io-decimal_io.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-decimal_io.adb
+
+$(ABASE)-text_io-enumeration_io.o: \
+ $(srcdir)/$(ABASE)-text_io-enumeration_io.ads \
+ $(srcdir)/$(ABASE)-text_io-enumeration_io.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-enumeration_io.adb
+
+$(ABASE)-text_io-modular_io.o: \
+ $(srcdir)/$(ABASE)-text_io-modular_io.ads \
+ $(srcdir)/$(ABASE)-text_io-modular_io.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-modular_io.adb
+
+$(ABASE)-text_io-complex_io.o: \
+ $(srcdir)/$(ABASE)-text_io-complex_io.ads \
+ $(srcdir)/$(ABASE)-text_io-complex_io.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-complex_io.adb
diff --git a/Ada95/src/terminal_interface-curses-aux.adb b/Ada95/src/terminal_interface-curses-aux.adb
new file mode 100644
index 0000000..812e8cc
--- /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 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
+------------------------------------------------------------------------------
+package body Terminal_Interface.Curses.Aux is
+ --
+ -- Some helpers
+ procedure Fill_String (Cp : in chars_ptr;
+ Str : out String)
+ is
+ -- Fill the string with the characters referenced by the
+ -- chars_ptr.
+ --
+ Len : Natural;
+ begin
+ if Cp /= Null_Ptr then
+ Len := Natural (Strlen (Cp));
+ if Str'Length < Len then
+ raise Constraint_Error;
+ end if;
+ declare
+ S : String (1 .. Len);
+ begin
+ S := Value (Cp);
+ Str (Str'First .. (Str'First + Len - 1)) := S (S'Range);
+ end;
+ else
+ Len := 0;
+ end if;
+
+ if Len < Str'Length then
+ Str ((Str'First + Len) .. Str'Last) := (others => ' ');
+ end if;
+
+ end Fill_String;
+
+ function Fill_String (Cp : chars_ptr) return String
+ is
+ Len : Natural;
+ begin
+ if Cp /= Null_Ptr then
+ Len := Natural (Strlen (Cp));
+ if Len = 0 then
+ return "";
+ else
+ declare
+ S : String (1 .. Len);
+ begin
+ Fill_String (Cp, S);
+ return S;
+ end;
+ end if;
+ else
+ return "";
+ end if;
+ end Fill_String;
+
+ procedure Eti_Exception (Code : Eti_Error)
+ is
+ begin
+ case Code is
+ when E_Ok => null;
+ when E_System_Error => raise Eti_System_Error;
+ when E_Bad_Argument => raise Eti_Bad_Argument;
+ when E_Posted => raise Eti_Posted;
+ when E_Connected => raise Eti_Connected;
+ when E_Bad_State => raise Eti_Bad_State;
+ when E_No_Room => raise Eti_No_Room;
+ when E_Not_Posted => raise Eti_Not_Posted;
+ when E_Unknown_Command => raise Eti_Unknown_Command;
+ when E_No_Match => raise Eti_No_Match;
+ when E_Not_Selectable => raise Eti_Not_Selectable;
+ when E_Not_Connected => raise Eti_Not_Connected;
+ when E_Request_Denied => raise Eti_Request_Denied;
+ when E_Invalid_Field => raise Eti_Invalid_Field;
+ when E_Current => raise Eti_Current;
+ end case;
+ end Eti_Exception;
+
+end Terminal_Interface.Curses.Aux;
diff --git a/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 0000000..f437ce6
--- /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 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 $
+-- $Date: 2008/07/26 18:50:25 $
+-- 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 : in Field;
+ Typ : in Alpha_Field)
+ is
+ C_Alpha_Field_Type : C_Field_Type;
+ pragma Import (C, C_Alpha_Field_Type, "TYPE_ALPHA");
+
+ function Set_Fld_Type (F : Field := Fld;
+ Cft : C_Field_Type := C_Alpha_Field_Type;
+ Arg1 : C_Int) return C_Int;
+ pragma Import (C, Set_Fld_Type, "set_field_type");
+
+ Res : Eti_Error;
+ begin
+ Res := Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width));
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ Wrap_Builtin (Fld, Typ);
+ end Set_Field_Type;
+
+end Terminal_Interface.Curses.Forms.Field_Types.Alpha;
diff --git a/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 0000000..6f0b79d
--- /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 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 Terminal_Interface.Curses.Forms.Field_Types.Alpha is
+ pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.Alpha);
+
+ type Alpha_Field is new Field_Type
+ with record
+ Minimum_Field_Width : Natural := 0;
+ end record;
+
+ procedure Set_Field_Type (Fld : in Field;
+ Typ : in Alpha_Field);
+ pragma Inline (Set_Field_Type);
+
+end Terminal_Interface.Curses.Forms.Field_Types.Alpha;
diff --git a/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 0000000..0c3ca29
--- /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 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 $
+-- $Date: 2008/07/26 18:50:15 $
+-- 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 : in Field;
+ Typ : in AlphaNumeric_Field)
+ is
+ C_AlphaNumeric_Field_Type : C_Field_Type;
+ pragma Import (C, C_AlphaNumeric_Field_Type, "TYPE_ALNUM");
+
+ function Set_Fld_Type (F : Field := Fld;
+ Cft : C_Field_Type := C_AlphaNumeric_Field_Type;
+ Arg1 : C_Int) return C_Int;
+ pragma Import (C, Set_Fld_Type, "set_field_type");
+
+ Res : Eti_Error;
+ begin
+ Res := Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width));
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ Wrap_Builtin (Fld, Typ);
+ end Set_Field_Type;
+
+end Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric;
diff --git a/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 0000000..1f21950
--- /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 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 Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric is
+ pragma Preelaborate
+ (Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric);
+
+ type AlphaNumeric_Field is new Field_Type
+ with record
+ Minimum_Field_Width : Natural := 0;
+ end record;
+
+ procedure Set_Field_Type (Fld : in Field;
+ Typ : in AlphaNumeric_Field);
+ pragma Inline (Set_Field_Type);
+
+end Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric;
diff --git a/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 0000000..b3eaf44
--- /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 0000000..48fad09
--- /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 0000000..8be20f2
--- /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 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.7 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Unchecked_Deallocation;
+with Interfaces.C; use Interfaces.C;
+with Interfaces.C.Strings; use Interfaces.C.Strings;
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+
+package body Terminal_Interface.Curses.Forms.Field_Types.Enumeration is
+
+ function Create (Info : Enumeration_Info;
+ Auto_Release_Names : Boolean := False)
+ return Enumeration_Field
+ is
+ procedure Release_String is
+ new Ada.Unchecked_Deallocation (String,
+ String_Access);
+ E : Enumeration_Field;
+ L : constant size_t := 1 + size_t (Info.C);
+ S : String_Access;
+ begin
+ E.Case_Sensitive := Info.Case_Sensitive;
+ E.Match_Must_Be_Unique := Info.Match_Must_Be_Unique;
+ E.Arr := new chars_ptr_array (size_t (1) .. L);
+ for I in 1 .. Positive (L - 1) loop
+ if Info.Names (I) = null then
+ raise Form_Exception;
+ end if;
+ E.Arr (size_t (I)) := New_String (Info.Names (I).all);
+ if Auto_Release_Names then
+ S := Info.Names (I);
+ Release_String (S);
+ end if;
+ end loop;
+ E.Arr (L) := Null_Ptr;
+ return E;
+ end Create;
+
+ procedure Release (Enum : in out Enumeration_Field)
+ is
+ I : size_t := 0;
+ P : chars_ptr;
+ begin
+ loop
+ P := Enum.Arr (I);
+ exit when P = Null_Ptr;
+ Free (P);
+ Enum.Arr (I) := Null_Ptr;
+ I := I + 1;
+ end loop;
+ Enum.Arr := null;
+ end Release;
+
+ procedure Set_Field_Type (Fld : in Field;
+ Typ : in Enumeration_Field)
+ is
+ C_Enum_Type : C_Field_Type;
+ pragma Import (C, C_Enum_Type, "TYPE_ENUM");
+
+ function Set_Fld_Type (F : Field := Fld;
+ Cft : C_Field_Type := C_Enum_Type;
+ Arg1 : chars_ptr_array;
+ Arg2 : C_Int;
+ Arg3 : C_Int) return C_Int;
+ pragma Import (C, Set_Fld_Type, "set_field_type");
+
+ Res : Eti_Error;
+ begin
+ if Typ.Arr = null then
+ raise Form_Exception;
+ end if;
+ Res := Set_Fld_Type (Arg1 => Typ.Arr.all,
+ Arg2 => C_Int (Boolean'Pos (Typ.Case_Sensitive)),
+ Arg3 => C_Int (Boolean'Pos
+ (Typ.Match_Must_Be_Unique)));
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ Wrap_Builtin (Fld, Typ, C_Choice_Router);
+ end Set_Field_Type;
+
+end Terminal_Interface.Curses.Forms.Field_Types.Enumeration;
diff --git a/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 0000000..5a7e411
--- /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 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 Interfaces.C.Strings;
+
+package Terminal_Interface.Curses.Forms.Field_Types.Enumeration is
+ pragma Preelaborate
+ (Terminal_Interface.Curses.Forms.Field_Types.Enumeration);
+
+ type String_Access is access String;
+
+ -- Type_Set is used by the child package Ada
+ type Type_Set is (Lower_Case, Upper_Case, Mixed_Case);
+
+ type Enum_Array is array (Positive range <>)
+ of String_Access;
+
+ type Enumeration_Info (C : Positive) is
+ record
+ Names : Enum_Array (1 .. C);
+ Case_Sensitive : Boolean := False;
+ Match_Must_Be_Unique : Boolean := False;
+ end record;
+
+ type Enumeration_Field is new Field_Type with private;
+
+ function Create (Info : Enumeration_Info;
+ Auto_Release_Names : Boolean := False)
+ return Enumeration_Field;
+ -- Make an fieldtype from the info. Enumerations are special, because
+ -- they normally don't copy the enum values into a private store, so
+ -- we have to care for the lifetime of the info we provide.
+ -- The Auto_Release_Names flag may be used to automatically releases
+ -- the strings in the Names array of the Enumeration_Info.
+
+ function Make_Enumeration_Type (Info : Enumeration_Info;
+ Auto_Release_Names : Boolean := False)
+ return Enumeration_Field renames Create;
+
+ procedure Release (Enum : in out Enumeration_Field);
+ -- But we may want to release the field to release the memory allocated
+ -- by it internally. After that the Enumeration field is no longer usable.
+
+ -- The next type defintions are all ncurses extensions. They are typically
+ -- not available in other curses implementations.
+
+ procedure Set_Field_Type (Fld : in Field;
+ Typ : in Enumeration_Field);
+ pragma Inline (Set_Field_Type);
+
+private
+ type CPA_Access is access Interfaces.C.Strings.chars_ptr_array;
+
+ type Enumeration_Field is new Field_Type with
+ record
+ Case_Sensitive : Boolean := False;
+ Match_Must_Be_Unique : Boolean := False;
+ Arr : CPA_Access := null;
+ end record;
+
+end Terminal_Interface.Curses.Forms.Field_Types.Enumeration;
diff --git a/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 0000000..61d66c4
--- /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 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 $
+-- $Date: 2008/07/26 18:50:06 $
+-- 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 : in Field;
+ Typ : in Integer_Field)
+ is
+ C_Integer_Field_Type : C_Field_Type;
+ pragma Import (C, C_Integer_Field_Type, "TYPE_INTEGER");
+
+ function Set_Fld_Type (F : Field := Fld;
+ Cft : C_Field_Type := C_Integer_Field_Type;
+ Arg1 : C_Int;
+ Arg2 : C_Long_Int;
+ Arg3 : C_Long_Int) return C_Int;
+ pragma Import (C, Set_Fld_Type, "set_field_type");
+
+ Res : Eti_Error;
+ begin
+ Res := Set_Fld_Type (Arg1 => C_Int (Typ.Precision),
+ Arg2 => C_Long_Int (Typ.Lower_Limit),
+ Arg3 => C_Long_Int (Typ.Upper_Limit));
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ Wrap_Builtin (Fld, Typ);
+ end Set_Field_Type;
+
+end Terminal_Interface.Curses.Forms.Field_Types.IntField;
diff --git a/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 0000000..b285ca2
--- /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 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 Terminal_Interface.Curses.Forms.Field_Types.IntField is
+ pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.IntField);
+
+ type Integer_Field is new Field_Type with
+ record
+ Precision : Natural;
+ Lower_Limit : Integer;
+ Upper_Limit : Integer;
+ end record;
+
+ procedure Set_Field_Type (Fld : in Field;
+ Typ : in Integer_Field);
+ pragma Inline (Set_Field_Type);
+
+end Terminal_Interface.Curses.Forms.Field_Types.IntField;
diff --git a/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 0000000..3d7c5b5
--- /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 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 $
+-- $Date: 2008/07/26 18:49:47 $
+-- 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 : in Field;
+ Typ : in Internet_V4_Address_Field)
+ is
+ C_IPV4_Field_Type : C_Field_Type;
+ pragma Import (C, C_IPV4_Field_Type, "TYPE_IPV4");
+
+ function Set_Fld_Type (F : Field := Fld;
+ Cft : C_Field_Type := C_IPV4_Field_Type)
+ return C_Int;
+ pragma Import (C, Set_Fld_Type, "set_field_type");
+
+ Res : Eti_Error;
+ begin
+ Res := Set_Fld_Type;
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ Wrap_Builtin (Fld, Typ);
+ end Set_Field_Type;
+
+end Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address;
diff --git a/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 0000000..6d0aef0
--- /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 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 Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address is
+ pragma Preelaborate
+ (Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address);
+
+ type Internet_V4_Address_Field is new Field_Type with null record;
+
+ procedure Set_Field_Type (Fld : in Field;
+ Typ : in Internet_V4_Address_Field);
+ pragma Inline (Set_Field_Type);
+
+end Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address;
diff --git a/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 0000000..79f8489
--- /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 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: 2008/07/26 18:49:57 $
+-- 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 : in Field;
+ Typ : in Numeric_Field)
+ is
+ type Double is new Interfaces.C.double;
+
+ C_Numeric_Field_Type : C_Field_Type;
+ pragma Import (C, C_Numeric_Field_Type, "TYPE_NUMERIC");
+
+ function Set_Fld_Type (F : Field := Fld;
+ Cft : C_Field_Type := C_Numeric_Field_Type;
+ Arg1 : C_Int;
+ Arg2 : Double;
+ Arg3 : Double) return C_Int;
+ pragma Import (C, Set_Fld_Type, "set_field_type");
+
+ Res : Eti_Error;
+ begin
+ Res := Set_Fld_Type (Arg1 => C_Int (Typ.Precision),
+ Arg2 => Double (Typ.Lower_Limit),
+ Arg3 => Double (Typ.Upper_Limit));
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ Wrap_Builtin (Fld, Typ);
+ end Set_Field_Type;
+
+end Terminal_Interface.Curses.Forms.Field_Types.Numeric;
diff --git a/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 0000000..f211bc8
--- /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 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 Terminal_Interface.Curses.Forms.Field_Types.Numeric is
+ pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.Numeric);
+
+ type Numeric_Field is new Field_Type with
+ record
+ Precision : Natural;
+ Lower_Limit : Float;
+ Upper_Limit : Float;
+ end record;
+
+ procedure Set_Field_Type (Fld : in Field;
+ Typ : in Numeric_Field);
+ pragma Inline (Set_Field_Type);
+
+end Terminal_Interface.Curses.Forms.Field_Types.Numeric;
diff --git a/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 0000000..cbd9e2f
--- /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 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 Interfaces.C; use Interfaces.C;
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+
+package body Terminal_Interface.Curses.Forms.Field_Types.RegExp is
+
+ procedure Set_Field_Type (Fld : in Field;
+ Typ : in Regular_Expression_Field)
+ is
+ type Char_Ptr is access all Interfaces.C.char;
+
+ C_Regexp_Field_Type : C_Field_Type;
+ pragma Import (C, C_Regexp_Field_Type, "TYPE_REGEXP");
+
+ function Set_Ftyp (F : Field := Fld;
+ Cft : C_Field_Type := C_Regexp_Field_Type;
+ Arg1 : Char_Ptr) return C_Int;
+ pragma Import (C, Set_Ftyp, "set_field_type");
+
+ Txt : char_array (0 .. Typ.Regular_Expression.all'Length);
+ Len : size_t;
+ Res : Eti_Error;
+ begin
+ To_C (Typ.Regular_Expression.all, Txt, Len);
+ Res := Set_Ftyp (Arg1 => Txt (Txt'First)'Access);
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ Wrap_Builtin (Fld, Typ);
+ end Set_Field_Type;
+
+end Terminal_Interface.Curses.Forms.Field_Types.RegExp;
diff --git a/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 0000000..1e451ab
--- /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 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 Terminal_Interface.Curses.Forms.Field_Types.RegExp is
+ pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.RegExp);
+
+ type String_Access is access String;
+
+ type Regular_Expression_Field is new Field_Type with
+ record
+ Regular_Expression : String_Access;
+ end record;
+
+ procedure Set_Field_Type (Fld : in Field;
+ Typ : in Regular_Expression_Field);
+ pragma Inline (Set_Field_Type);
+
+end Terminal_Interface.Curses.Forms.Field_Types.RegExp;
diff --git a/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 0000000..f26a42c
--- /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 0000000..1e69f43
--- /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 0000000..0b4c136
--- /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-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:49:28 $
+-- 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 : in Field;
+ Typ : in User_Defined_Field_Type)
+ is
+ function Allocate_Arg (T : User_Defined_Field_Type'Class)
+ return Argument_Access;
+
+ function Set_Fld_Type (F : Field := Fld;
+ Cft : C_Field_Type := C_Generic_Type;
+ Arg1 : Argument_Access)
+ return C_Int;
+ pragma Import (C, Set_Fld_Type, "set_field_type");
+
+ Res : Eti_Error;
+
+ function Allocate_Arg (T : User_Defined_Field_Type'Class)
+ return Argument_Access
+ is
+ Ptr : 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 0000000..acec636
--- /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 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:38 $
+-- 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 : in Field;
+ Typ : in User_Defined_Field_Type);
+ -- This should work for all types derived from User_Defined_Field_Type.
+ -- No need to reimplement it for your derived type.
+
+ -- +----------------------------------------------------------------------
+ -- | Private Part.
+ -- | Used by the Choice child package.
+private
+ 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 0000000..c681c80
--- /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-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.20 $
+-- $Date: 2008/07/26 18:50:33 $
+-- 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 : in Field) return Field_Type_Access
+ is
+ Low_Level : constant C_Field_Type := Get_Fieldtype (Fld);
+ Arg : Argument_Access;
+ begin
+ if Low_Level = Null_Field_Type then
+ return null;
+ else
+ if Low_Level = M_Builtin_Router or else
+ Low_Level = M_Generic_Type or else
+ Low_Level = M_Choice_Router or else
+ Low_Level = M_Generic_Choice then
+ Arg := To_Argument_Access (Get_Arg (Fld));
+ if Arg = null then
+ raise Form_Exception;
+ else
+ return Arg.Typ;
+ end if;
+ else
+ raise Form_Exception;
+ end if;
+ end if;
+ end Get_Type;
+
+ function Make_Arg (Args : System.Address) return System.Address
+ is
+ -- Actually args is a double indirected pointer to the arguments
+ -- of a C variable argument list. In theory it is now quite
+ -- complicated to write portable routine that reads the arguments,
+ -- because one has to know the growth direction of the stack and
+ -- the sizes of the individual arguments.
+ -- Fortunately we are only interested in the first argument (#0),
+ -- we know its size and for the first arg we don't care about
+ -- into which stack direction we have to proceed. We simply
+ -- resolve the double indirection and thats it.
+ type V is access all System.Address;
+ function To_Access is new Ada.Unchecked_Conversion (System.Address,
+ V);
+ begin
+ return To_Access (To_Access (Args).all).all;
+ end Make_Arg;
+
+ function Copy_Arg (Usr : System.Address) return System.Address
+ is
+ begin
+ return Usr;
+ end Copy_Arg;
+
+ procedure Free_Arg (Usr : in System.Address)
+ is
+ procedure Free_Type is new Ada.Unchecked_Deallocation
+ (Field_Type'Class, Field_Type_Access);
+ procedure Freeargs is new Ada.Unchecked_Deallocation
+ (Argument, Argument_Access);
+
+ To_Be_Free : Argument_Access := To_Argument_Access (Usr);
+ Low_Level : C_Field_Type;
+ begin
+ if To_Be_Free /= null then
+ if To_Be_Free.Usr /= System.Null_Address then
+ Low_Level := To_Be_Free.Cft;
+ if Low_Level.Freearg /= null then
+ Low_Level.Freearg (To_Be_Free.Usr);
+ end if;
+ end if;
+ if To_Be_Free.Typ /= null then
+ Free_Type (To_Be_Free.Typ);
+ end if;
+ Freeargs (To_Be_Free);
+ end if;
+ end Free_Arg;
+
+ procedure Wrap_Builtin (Fld : Field;
+ Typ : Field_Type'Class;
+ Cft : C_Field_Type := C_Builtin_Router)
+ is
+ Usr_Arg : 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 0000000..817ebe5
--- /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 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 Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+
+-- |
+-- |=====================================================================
+-- | man page form_field_userptr.3x
+-- |=====================================================================
+-- |
+package body Terminal_Interface.Curses.Forms.Field_User_Data is
+ -- |
+ -- |
+ -- |
+ use type Interfaces.C.int;
+
+ procedure Set_User_Data (Fld : in Field;
+ Data : in User_Access)
+ is
+ function Set_Field_Userptr (Fld : Field;
+ Usr : User_Access) return C_Int;
+ pragma Import (C, Set_Field_Userptr, "set_field_userptr");
+
+ Res : constant Eti_Error := Set_Field_Userptr (Fld, Data);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_User_Data;
+ -- |
+ -- |
+ -- |
+ function Get_User_Data (Fld : in Field) return User_Access
+ is
+ function Field_Userptr (Fld : Field) return User_Access;
+ pragma Import (C, Field_Userptr, "field_userptr");
+ begin
+ return Field_Userptr (Fld);
+ end Get_User_Data;
+
+ procedure Get_User_Data (Fld : in Field;
+ Data : out User_Access)
+ is
+ begin
+ Data := Get_User_Data (Fld);
+ end Get_User_Data;
+
+end Terminal_Interface.Curses.Forms.Field_User_Data;
diff --git a/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 0000000..50c6708
--- /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 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
+------------------------------------------------------------------------------
+-- |
+-- |=====================================================================
+-- | man page form__userptr.3x
+-- |=====================================================================
+-- |
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+
+package body Terminal_Interface.Curses.Forms.Form_User_Data is
+
+ use type Interfaces.C.int;
+
+ -- |
+ -- |
+ -- |
+ procedure Set_User_Data (Frm : in Form;
+ Data : in User_Access)
+ is
+ function Set_Form_Userptr (Frm : Form;
+ Data : User_Access) return C_Int;
+ pragma Import (C, Set_Form_Userptr, "set_form_userptr");
+
+ Res : constant Eti_Error := Set_Form_Userptr (Frm, Data);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_User_Data;
+ -- |
+ -- |
+ -- |
+ function Get_User_Data (Frm : in Form) return User_Access
+ is
+ function Form_Userptr (Frm : Form) return User_Access;
+ pragma Import (C, Form_Userptr, "form_userptr");
+ begin
+ return Form_Userptr (Frm);
+ end Get_User_Data;
+
+ procedure Get_User_Data (Frm : in Form;
+ Data : out User_Access)
+ is
+ begin
+ Data := Get_User_Data (Frm);
+ end Get_User_Data;
+
+end Terminal_Interface.Curses.Forms.Form_User_Data;
diff --git a/Ada95/src/terminal_interface-curses-forms.adb b/Ada95/src/terminal_interface-curses-forms.adb
new file mode 100644
index 0000000..8b01e16
--- /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-2004,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.26 $
+-- $Date: 2008/07/26 18:50:44 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Unchecked_Deallocation;
+with Ada.Unchecked_Conversion;
+
+with Interfaces.C; use Interfaces.C;
+with Interfaces.C.Strings; use Interfaces.C.Strings;
+with Interfaces.C.Pointers;
+
+with Terminal_Interface.Curses.Aux;
+
+package body Terminal_Interface.Curses.Forms is
+
+ use Terminal_Interface.Curses.Aux;
+
+ type C_Field_Array is array (Natural range <>) of aliased Field;
+ package F_Array is new
+ Interfaces.C.Pointers (Natural, Field, C_Field_Array, Null_Field);
+
+------------------------------------------------------------------------------
+ -- |
+ -- |
+ -- |
+ -- subtype chars_ptr is Interfaces.C.Strings.chars_ptr;
+
+ function FOS_2_CInt is new
+ Ada.Unchecked_Conversion (Field_Option_Set,
+ C_Int);
+
+ function CInt_2_FOS is new
+ Ada.Unchecked_Conversion (C_Int,
+ Field_Option_Set);
+
+ function FrmOS_2_CInt is new
+ Ada.Unchecked_Conversion (Form_Option_Set,
+ C_Int);
+
+ function CInt_2_FrmOS is new
+ Ada.Unchecked_Conversion (C_Int,
+ Form_Option_Set);
+
+ procedure Request_Name (Key : in Form_Request_Code;
+ Name : out String)
+ is
+ function Form_Request_Name (Key : C_Int) return chars_ptr;
+ pragma Import (C, Form_Request_Name, "form_request_name");
+ begin
+ Fill_String (Form_Request_Name (C_Int (Key)), Name);
+ end Request_Name;
+
+ function Request_Name (Key : Form_Request_Code) return String
+ is
+ function Form_Request_Name (Key : C_Int) return chars_ptr;
+ pragma Import (C, Form_Request_Name, "form_request_name");
+ begin
+ return Fill_String (Form_Request_Name (C_Int (Key)));
+ end Request_Name;
+------------------------------------------------------------------------------
+ -- |
+ -- |
+ -- |
+ -- |
+ -- |=====================================================================
+ -- | man page form_field_new.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ function Create (Height : Line_Count;
+ Width : Column_Count;
+ Top : Line_Position;
+ Left : Column_Position;
+ Off_Screen : Natural := 0;
+ More_Buffers : Buffer_Number := Buffer_Number'First)
+ return Field
+ is
+ function Newfield (H, W, T, L, O, M : C_Int) return Field;
+ pragma Import (C, Newfield, "new_field");
+ Fld : constant Field := Newfield (C_Int (Height), C_Int (Width),
+ C_Int (Top), C_Int (Left),
+ C_Int (Off_Screen),
+ C_Int (More_Buffers));
+ begin
+ if Fld = Null_Field then
+ raise Form_Exception;
+ end if;
+ return Fld;
+ end Create;
+-- |
+-- |
+-- |
+ procedure Delete (Fld : in out Field)
+ is
+ function Free_Field (Fld : Field) return C_Int;
+ pragma Import (C, Free_Field, "free_field");
+
+ Res : Eti_Error;
+ begin
+ Res := Free_Field (Fld);
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ Fld := Null_Field;
+ end Delete;
+ -- |
+ -- |
+ -- |
+ function Duplicate (Fld : Field;
+ Top : Line_Position;
+ Left : Column_Position) return Field
+ is
+ function Dup_Field (Fld : Field;
+ Top : C_Int;
+ Left : C_Int) return Field;
+ pragma Import (C, Dup_Field, "dup_field");
+
+ F : constant Field := Dup_Field (Fld,
+ C_Int (Top),
+ C_Int (Left));
+ begin
+ if F = Null_Field then
+ raise Form_Exception;
+ end if;
+ return F;
+ end Duplicate;
+ -- |
+ -- |
+ -- |
+ function Link (Fld : Field;
+ Top : Line_Position;
+ Left : Column_Position) return Field
+ is
+ function Lnk_Field (Fld : Field;
+ Top : C_Int;
+ Left : C_Int) return Field;
+ pragma Import (C, Lnk_Field, "link_field");
+
+ F : constant Field := Lnk_Field (Fld,
+ C_Int (Top),
+ C_Int (Left));
+ begin
+ if F = Null_Field then
+ raise Form_Exception;
+ end if;
+ return F;
+ end Link;
+ -- |
+ -- |=====================================================================
+ -- | man page form_field_just.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Set_Justification (Fld : in Field;
+ Just : in Field_Justification := None)
+ is
+ function Set_Field_Just (Fld : Field;
+ Just : C_Int) return C_Int;
+ pragma Import (C, Set_Field_Just, "set_field_just");
+
+ Res : constant Eti_Error :=
+ Set_Field_Just (Fld,
+ C_Int (Field_Justification'Pos (Just)));
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Justification;
+ -- |
+ -- |
+ -- |
+ function Get_Justification (Fld : Field) return Field_Justification
+ is
+ function Field_Just (Fld : Field) return C_Int;
+ pragma Import (C, Field_Just, "field_just");
+ begin
+ return Field_Justification'Val (Field_Just (Fld));
+ end Get_Justification;
+ -- |
+ -- |=====================================================================
+ -- | man page form_field_buffer.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Set_Buffer
+ (Fld : in Field;
+ Buffer : in Buffer_Number := Buffer_Number'First;
+ Str : in String)
+ is
+ type Char_Ptr is access all Interfaces.C.char;
+ function Set_Fld_Buffer (Fld : Field;
+ Bufnum : C_Int;
+ S : Char_Ptr)
+ return C_Int;
+ pragma Import (C, Set_Fld_Buffer, "set_field_buffer");
+
+ Txt : char_array (0 .. Str'Length);
+ Len : size_t;
+ Res : Eti_Error;
+ begin
+ To_C (Str, Txt, Len);
+ Res := Set_Fld_Buffer (Fld, C_Int (Buffer), Txt (Txt'First)'Access);
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Buffer;
+ -- |
+ -- |
+ -- |
+ procedure Get_Buffer
+ (Fld : in Field;
+ Buffer : in Buffer_Number := Buffer_Number'First;
+ Str : out String)
+ is
+ function Field_Buffer (Fld : Field;
+ B : C_Int) return chars_ptr;
+ pragma Import (C, Field_Buffer, "field_buffer");
+ begin
+ Fill_String (Field_Buffer (Fld, C_Int (Buffer)), Str);
+ end Get_Buffer;
+
+ function Get_Buffer
+ (Fld : in Field;
+ Buffer : in Buffer_Number := Buffer_Number'First) return String
+ is
+ function Field_Buffer (Fld : Field;
+ B : C_Int) return chars_ptr;
+ pragma Import (C, Field_Buffer, "field_buffer");
+ begin
+ return Fill_String (Field_Buffer (Fld, C_Int (Buffer)));
+ end Get_Buffer;
+ -- |
+ -- |
+ -- |
+ procedure Set_Status (Fld : in Field;
+ Status : in Boolean := True)
+ is
+ function Set_Fld_Status (Fld : Field;
+ St : C_Int) return C_Int;
+ pragma Import (C, Set_Fld_Status, "set_field_status");
+
+ Res : constant Eti_Error := Set_Fld_Status (Fld, Boolean'Pos (Status));
+ begin
+ if Res /= E_Ok then
+ raise Form_Exception;
+ end if;
+ end Set_Status;
+ -- |
+ -- |
+ -- |
+ function Changed (Fld : Field) return Boolean
+ is
+ function Field_Status (Fld : Field) return C_Int;
+ pragma Import (C, Field_Status, "field_status");
+
+ Res : constant C_Int := Field_Status (Fld);
+ begin
+ if Res = Curses_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Changed;
+ -- |
+ -- |
+ -- |
+ procedure Set_Maximum_Size (Fld : in Field;
+ Max : in Natural := 0)
+ is
+ function Set_Field_Max (Fld : Field;
+ M : C_Int) return C_Int;
+ pragma Import (C, Set_Field_Max, "set_max_field");
+
+ Res : constant Eti_Error := Set_Field_Max (Fld, C_Int (Max));
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Maximum_Size;
+ -- |
+ -- |=====================================================================
+ -- | man page form_field_opts.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Set_Options (Fld : in Field;
+ Options : in Field_Option_Set)
+ is
+ function Set_Field_Opts (Fld : Field;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Set_Field_Opts, "set_field_opts");
+
+ Opt : 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 : in Field;
+ Options : in Field_Option_Set;
+ On : Boolean := True)
+ is
+ function Field_Opts_On (Fld : Field;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Field_Opts_On, "field_opts_on");
+ function Field_Opts_Off (Fld : Field;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Field_Opts_Off, "field_opts_off");
+
+ Err : Eti_Error;
+ Opt : 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 : in 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 : in Field;
+ Fore : in Character_Attribute_Set := Normal_Video;
+ Color : in Color_Pair := Color_Pair'First)
+ is
+ function Set_Field_Fore (Fld : Field;
+ Attr : C_Chtype) return C_Int;
+ pragma Import (C, Set_Field_Fore, "set_field_fore");
+
+ Ch : constant Attributed_Character := (Ch => Character'First,
+ Color => Color,
+ Attr => Fore);
+ Res : constant Eti_Error :=
+ Set_Field_Fore (Fld, AttrChar_To_Chtype (Ch));
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Foreground;
+ -- |
+ -- |
+ -- |
+ procedure Foreground (Fld : in Field;
+ Fore : out Character_Attribute_Set)
+ is
+ function Field_Fore (Fld : Field) return C_Chtype;
+ pragma Import (C, Field_Fore, "field_fore");
+ begin
+ Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr;
+ end Foreground;
+
+ procedure Foreground (Fld : in Field;
+ Fore : out Character_Attribute_Set;
+ Color : out Color_Pair)
+ is
+ function Field_Fore (Fld : Field) return C_Chtype;
+ pragma Import (C, Field_Fore, "field_fore");
+ begin
+ Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr;
+ Color := Chtype_To_AttrChar (Field_Fore (Fld)).Color;
+ end Foreground;
+ -- |
+ -- |
+ -- |
+ procedure Set_Background
+ (Fld : in Field;
+ Back : in Character_Attribute_Set := Normal_Video;
+ Color : in Color_Pair := Color_Pair'First)
+ is
+ function Set_Field_Back (Fld : Field;
+ Attr : C_Chtype) return C_Int;
+ pragma Import (C, Set_Field_Back, "set_field_back");
+
+ Ch : constant Attributed_Character := (Ch => Character'First,
+ Color => Color,
+ Attr => Back);
+ Res : constant Eti_Error :=
+ Set_Field_Back (Fld, AttrChar_To_Chtype (Ch));
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Background;
+ -- |
+ -- |
+ -- |
+ procedure Background (Fld : in Field;
+ Back : out Character_Attribute_Set)
+ is
+ function Field_Back (Fld : Field) return C_Chtype;
+ pragma Import (C, Field_Back, "field_back");
+ begin
+ Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr;
+ end Background;
+
+ procedure Background (Fld : in Field;
+ Back : out Character_Attribute_Set;
+ Color : out Color_Pair)
+ is
+ function Field_Back (Fld : Field) return C_Chtype;
+ pragma Import (C, Field_Back, "field_back");
+ begin
+ Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr;
+ Color := Chtype_To_AttrChar (Field_Back (Fld)).Color;
+ end Background;
+ -- |
+ -- |
+ -- |
+ procedure Set_Pad_Character (Fld : in Field;
+ Pad : in Character := Space)
+ is
+ function Set_Field_Pad (Fld : Field;
+ Ch : C_Int) return C_Int;
+ pragma Import (C, Set_Field_Pad, "set_field_pad");
+
+ Res : constant Eti_Error := Set_Field_Pad (Fld,
+ C_Int (Character'Pos (Pad)));
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Pad_Character;
+ -- |
+ -- |
+ -- |
+ procedure Pad_Character (Fld : in Field;
+ Pad : out Character)
+ is
+ function Field_Pad (Fld : Field) return C_Int;
+ pragma Import (C, Field_Pad, "field_pad");
+ begin
+ Pad := Character'Val (Field_Pad (Fld));
+ end Pad_Character;
+ -- |
+ -- |=====================================================================
+ -- | man page form_field_info.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Info (Fld : in Field;
+ Lines : out Line_Count;
+ Columns : out Column_Count;
+ First_Row : out Line_Position;
+ First_Column : out Column_Position;
+ Off_Screen : out Natural;
+ Additional_Buffers : out Buffer_Number)
+ is
+ type C_Int_Access is access all C_Int;
+ function Fld_Info (Fld : Field;
+ L, C, Fr, Fc, Os, Ab : C_Int_Access)
+ return C_Int;
+ pragma Import (C, Fld_Info, "field_info");
+
+ L, C, Fr, Fc, Os, Ab : aliased C_Int;
+ Res : constant Eti_Error := Fld_Info (Fld,
+ L'Access, C'Access,
+ Fr'Access, Fc'Access,
+ Os'Access, Ab'Access);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ else
+ Lines := Line_Count (L);
+ Columns := Column_Count (C);
+ First_Row := Line_Position (Fr);
+ First_Column := Column_Position (Fc);
+ Off_Screen := Natural (Os);
+ Additional_Buffers := Buffer_Number (Ab);
+ end if;
+ end Info;
+-- |
+-- |
+-- |
+ procedure Dynamic_Info (Fld : in Field;
+ Lines : out Line_Count;
+ Columns : out Column_Count;
+ Max : out Natural)
+ is
+ type C_Int_Access is access all C_Int;
+ function Dyn_Info (Fld : Field; L, C, M : C_Int_Access) return C_Int;
+ pragma Import (C, Dyn_Info, "dynamic_field_info");
+
+ L, C, M : aliased C_Int;
+ Res : constant Eti_Error := Dyn_Info (Fld,
+ L'Access, C'Access,
+ M'Access);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ else
+ Lines := Line_Count (L);
+ Columns := Column_Count (C);
+ Max := Natural (M);
+ end if;
+ end Dynamic_Info;
+ -- |
+ -- |=====================================================================
+ -- | man page form_win.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Set_Window (Frm : in Form;
+ Win : in Window)
+ is
+ function Set_Form_Win (Frm : Form;
+ Win : Window) return C_Int;
+ pragma Import (C, Set_Form_Win, "set_form_win");
+
+ Res : constant Eti_Error := Set_Form_Win (Frm, Win);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Window;
+ -- |
+ -- |
+ -- |
+ function Get_Window (Frm : Form) return Window
+ is
+ function Form_Win (Frm : Form) return Window;
+ pragma Import (C, Form_Win, "form_win");
+
+ W : constant Window := Form_Win (Frm);
+ begin
+ return W;
+ end Get_Window;
+ -- |
+ -- |
+ -- |
+ procedure Set_Sub_Window (Frm : in Form;
+ Win : in Window)
+ is
+ function Set_Form_Sub (Frm : Form;
+ Win : Window) return C_Int;
+ pragma Import (C, Set_Form_Sub, "set_form_sub");
+
+ Res : constant Eti_Error := Set_Form_Sub (Frm, Win);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Sub_Window;
+ -- |
+ -- |
+ -- |
+ function Get_Sub_Window (Frm : Form) return Window
+ is
+ function Form_Sub (Frm : Form) return Window;
+ pragma Import (C, Form_Sub, "form_sub");
+
+ W : constant Window := Form_Sub (Frm);
+ begin
+ return W;
+ end Get_Sub_Window;
+ -- |
+ -- |
+ -- |
+ procedure Scale (Frm : in Form;
+ Lines : out Line_Count;
+ Columns : out Column_Count)
+ is
+ type C_Int_Access is access all C_Int;
+ function M_Scale (Frm : Form; Yp, Xp : C_Int_Access) return C_Int;
+ pragma Import (C, M_Scale, "scale_form");
+
+ X, Y : aliased C_Int;
+ Res : constant Eti_Error := M_Scale (Frm, Y'Access, X'Access);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ Lines := Line_Count (Y);
+ Columns := Column_Count (X);
+ end Scale;
+ -- |
+ -- |=====================================================================
+ -- | man page menu_hook.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Set_Field_Init_Hook (Frm : in Form;
+ Proc : in Form_Hook_Function)
+ is
+ function Set_Field_Init (Frm : Form;
+ Proc : Form_Hook_Function) return C_Int;
+ pragma Import (C, Set_Field_Init, "set_field_init");
+
+ Res : constant Eti_Error := Set_Field_Init (Frm, Proc);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Field_Init_Hook;
+ -- |
+ -- |
+ -- |
+ procedure Set_Field_Term_Hook (Frm : in Form;
+ Proc : in Form_Hook_Function)
+ is
+ function Set_Field_Term (Frm : Form;
+ Proc : Form_Hook_Function) return C_Int;
+ pragma Import (C, Set_Field_Term, "set_field_term");
+
+ Res : constant Eti_Error := Set_Field_Term (Frm, Proc);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Field_Term_Hook;
+ -- |
+ -- |
+ -- |
+ procedure Set_Form_Init_Hook (Frm : in Form;
+ Proc : in Form_Hook_Function)
+ is
+ function Set_Form_Init (Frm : Form;
+ Proc : Form_Hook_Function) return C_Int;
+ pragma Import (C, Set_Form_Init, "set_form_init");
+
+ Res : constant Eti_Error := Set_Form_Init (Frm, Proc);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Form_Init_Hook;
+ -- |
+ -- |
+ -- |
+ procedure Set_Form_Term_Hook (Frm : in Form;
+ Proc : in Form_Hook_Function)
+ is
+ function Set_Form_Term (Frm : Form;
+ Proc : Form_Hook_Function) return C_Int;
+ pragma Import (C, Set_Form_Term, "set_form_term");
+
+ Res : constant Eti_Error := Set_Form_Term (Frm, Proc);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Form_Term_Hook;
+ -- |
+ -- |=====================================================================
+ -- | man page form_fields.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Redefine (Frm : in Form;
+ Flds : in Field_Array_Access)
+ is
+ function Set_Frm_Fields (Frm : Form;
+ Items : System.Address) return C_Int;
+ pragma Import (C, Set_Frm_Fields, "set_form_fields");
+
+ Res : Eti_Error;
+ begin
+ pragma Assert (Flds (Flds'Last) = Null_Field);
+ if Flds (Flds'Last) /= Null_Field then
+ raise Form_Exception;
+ else
+ Res := Set_Frm_Fields (Frm, Flds (Flds'First)'Address);
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end if;
+ end Redefine;
+ -- |
+ -- |
+ -- |
+ function Fields (Frm : Form;
+ Index : Positive) return Field
+ is
+ use F_Array;
+
+ function C_Fields (Frm : Form) return Pointer;
+ pragma Import (C, C_Fields, "form_fields");
+
+ P : Pointer := C_Fields (Frm);
+ begin
+ if P = null or else Index > Field_Count (Frm) then
+ raise Form_Exception;
+ else
+ P := P + ptrdiff_t (C_Int (Index) - 1);
+ return P.all;
+ end if;
+ end Fields;
+ -- |
+ -- |
+ -- |
+ function Field_Count (Frm : Form) return Natural
+ is
+ function Count (Frm : Form) return C_Int;
+ pragma Import (C, Count, "field_count");
+ begin
+ return Natural (Count (Frm));
+ end Field_Count;
+ -- |
+ -- |
+ -- |
+ procedure Move (Fld : in Field;
+ Line : in Line_Position;
+ Column : in Column_Position)
+ is
+ function Move (Fld : Field; L, C : C_Int) return C_Int;
+ pragma Import (C, Move, "move_field");
+
+ Res : constant Eti_Error := Move (Fld, C_Int (Line), C_Int (Column));
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Move;
+ -- |
+ -- |=====================================================================
+ -- | man page form_new.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ function Create (Fields : Field_Array_Access) return Form
+ is
+ function NewForm (Fields : System.Address) return Form;
+ pragma Import (C, NewForm, "new_form");
+
+ M : Form;
+ begin
+ pragma Assert (Fields (Fields'Last) = Null_Field);
+ if Fields (Fields'Last) /= Null_Field then
+ raise Form_Exception;
+ else
+ M := NewForm (Fields (Fields'First)'Address);
+ if M = Null_Form then
+ raise Form_Exception;
+ end if;
+ return M;
+ end if;
+ end Create;
+ -- |
+ -- |
+ -- |
+ procedure Delete (Frm : in out Form)
+ is
+ function Free (Frm : Form) return C_Int;
+ pragma Import (C, Free, "free_form");
+
+ Res : constant Eti_Error := Free (Frm);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ Frm := Null_Form;
+ end Delete;
+ -- |
+ -- |=====================================================================
+ -- | man page form_opts.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Set_Options (Frm : in Form;
+ Options : in Form_Option_Set)
+ is
+ function Set_Form_Opts (Frm : Form;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Set_Form_Opts, "set_form_opts");
+
+ Opt : 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 : in Form;
+ Options : in Form_Option_Set;
+ On : Boolean := True)
+ is
+ function Form_Opts_On (Frm : Form;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Form_Opts_On, "form_opts_on");
+ function Form_Opts_Off (Frm : Form;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Form_Opts_Off, "form_opts_off");
+
+ Err : Eti_Error;
+ Opt : 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 : in 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 : in Form;
+ Post : in Boolean := True)
+ is
+ function M_Post (Frm : Form) return C_Int;
+ pragma Import (C, M_Post, "post_form");
+ function M_Unpost (Frm : Form) return C_Int;
+ pragma Import (C, M_Unpost, "unpost_form");
+
+ Res : Eti_Error;
+ begin
+ if Post then
+ Res := M_Post (Frm);
+ else
+ Res := M_Unpost (Frm);
+ end if;
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Post;
+ -- |
+ -- |=====================================================================
+ -- | man page form_cursor.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Position_Cursor (Frm : Form)
+ is
+ function Pos_Form_Cursor (Frm : Form) return C_Int;
+ pragma Import (C, Pos_Form_Cursor, "pos_form_cursor");
+
+ Res : constant Eti_Error := Pos_Form_Cursor (Frm);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Position_Cursor;
+ -- |
+ -- |=====================================================================
+ -- | man page form_data.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ function Data_Ahead (Frm : Form) return Boolean
+ is
+ function Ahead (Frm : Form) return C_Int;
+ pragma Import (C, Ahead, "data_ahead");
+
+ Res : constant C_Int := Ahead (Frm);
+ begin
+ if Res = Curses_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Data_Ahead;
+ -- |
+ -- |
+ -- |
+ function Data_Behind (Frm : Form) return Boolean
+ is
+ function Behind (Frm : Form) return C_Int;
+ pragma Import (C, Behind, "data_behind");
+
+ Res : constant C_Int := Behind (Frm);
+ begin
+ if Res = Curses_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Data_Behind;
+ -- |
+ -- |=====================================================================
+ -- | man page form_driver.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ function Driver (Frm : Form;
+ Key : Key_Code) return Driver_Result
+ is
+ function Frm_Driver (Frm : Form; Key : C_Int) return C_Int;
+ pragma Import (C, Frm_Driver, "form_driver");
+
+ R : 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 : in Form;
+ Fld : in Field)
+ is
+ function Set_Current_Fld (Frm : Form; Fld : Field) return C_Int;
+ pragma Import (C, Set_Current_Fld, "set_current_field");
+
+ Res : constant Eti_Error := Set_Current_Fld (Frm, Fld);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Current;
+ -- |
+ -- |
+ -- |
+ function Current (Frm : in Form) return Field
+ is
+ function Current_Fld (Frm : Form) return Field;
+ pragma Import (C, Current_Fld, "current_field");
+
+ Fld : constant Field := Current_Fld (Frm);
+ begin
+ if Fld = Null_Field then
+ raise Form_Exception;
+ end if;
+ return Fld;
+ end Current;
+ -- |
+ -- |
+ -- |
+ procedure Set_Page (Frm : in Form;
+ Page : in Page_Number := Page_Number'First)
+ is
+ function Set_Frm_Page (Frm : Form; Pg : C_Int) return C_Int;
+ pragma Import (C, Set_Frm_Page, "set_form_page");
+
+ Res : constant Eti_Error := Set_Frm_Page (Frm, C_Int (Page));
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Page;
+ -- |
+ -- |
+ -- |
+ function Page (Frm : Form) return Page_Number
+ is
+ function Get_Page (Frm : Form) return C_Int;
+ pragma Import (C, Get_Page, "form_page");
+
+ P : constant C_Int := Get_Page (Frm);
+ begin
+ if P < 0 then
+ raise Form_Exception;
+ else
+ return Page_Number (P);
+ end if;
+ end Page;
+
+ function Get_Index (Fld : Field) return Positive
+ is
+ function Get_Fieldindex (Fld : Field) return C_Int;
+ pragma Import (C, Get_Fieldindex, "field_index");
+
+ Res : constant C_Int := Get_Fieldindex (Fld);
+ begin
+ if Res = Curses_Err then
+ raise Form_Exception;
+ end if;
+ return Positive (Natural (Res) + Positive'First);
+ end Get_Index;
+
+ -- |
+ -- |=====================================================================
+ -- | man page form_new_page.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Set_New_Page (Fld : in Field;
+ New_Page : in Boolean := True)
+ is
+ function Set_Page (Fld : Field; Flg : C_Int) return C_Int;
+ pragma Import (C, Set_Page, "set_new_page");
+
+ Res : constant Eti_Error := Set_Page (Fld, Boolean'Pos (New_Page));
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_New_Page;
+ -- |
+ -- |
+ -- |
+ function Is_New_Page (Fld : Field) return Boolean
+ is
+ function Is_New (Fld : Field) return C_Int;
+ pragma Import (C, Is_New, "new_page");
+
+ Res : constant C_Int := Is_New (Fld);
+ begin
+ if Res = Curses_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Is_New_Page;
+
+ procedure Free (FA : in out Field_Array_Access;
+ Free_Fields : in Boolean := False)
+ is
+ procedure Release is new Ada.Unchecked_Deallocation
+ (Field_Array, Field_Array_Access);
+ begin
+ if FA /= null and then Free_Fields then
+ for I in FA'First .. (FA'Last - 1) loop
+ if FA (I) /= Null_Field then
+ Delete (FA (I));
+ end if;
+ end loop;
+ end if;
+ Release (FA);
+ end Free;
+
+ -- |=====================================================================
+
+ function Default_Field_Options return Field_Option_Set
+ is
+ begin
+ return Get_Options (Null_Field);
+ end Default_Field_Options;
+
+ function Default_Form_Options return Form_Option_Set
+ is
+ begin
+ return Get_Options (Null_Form);
+ end Default_Form_Options;
+
+end Terminal_Interface.Curses.Forms;
diff --git a/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 0000000..6c35d33
--- /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 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 Interfaces.C;
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+
+package body Terminal_Interface.Curses.Menus.Item_User_Data is
+
+ use type Interfaces.C.int;
+
+ procedure Set_User_Data (Itm : in Item;
+ Data : in User_Access)
+ is
+ function Set_Item_Userptr (Itm : Item;
+ Addr : User_Access) return C_Int;
+ pragma Import (C, Set_Item_Userptr, "set_item_userptr");
+
+ Res : constant Eti_Error := Set_Item_Userptr (Itm, Data);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_User_Data;
+
+ function Get_User_Data (Itm : in Item) return User_Access
+ is
+ function Item_Userptr (Itm : Item) return User_Access;
+ pragma Import (C, Item_Userptr, "item_userptr");
+ begin
+ return Item_Userptr (Itm);
+ end Get_User_Data;
+
+ procedure Get_User_Data (Itm : in Item;
+ Data : out User_Access)
+ is
+ begin
+ Data := Get_User_Data (Itm);
+ end Get_User_Data;
+
+end Terminal_Interface.Curses.Menus.Item_User_Data;
diff --git a/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 0000000..20b9e86
--- /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 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 Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+
+package body Terminal_Interface.Curses.Menus.Menu_User_Data is
+
+ use type Interfaces.C.int;
+
+ procedure Set_User_Data (Men : in Menu;
+ Data : in User_Access)
+ is
+ function Set_Menu_Userptr (Men : Menu;
+ Data : User_Access) return C_Int;
+ pragma Import (C, Set_Menu_Userptr, "set_menu_userptr");
+
+ Res : constant Eti_Error := Set_Menu_Userptr (Men, Data);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_User_Data;
+
+ function Get_User_Data (Men : in Menu) return User_Access
+ is
+ function Menu_Userptr (Men : Menu) return User_Access;
+ pragma Import (C, Menu_Userptr, "menu_userptr");
+ begin
+ return Menu_Userptr (Men);
+ end Get_User_Data;
+
+ procedure Get_User_Data (Men : in Menu;
+ Data : out User_Access)
+ is
+ begin
+ Data := Get_User_Data (Men);
+ end Get_User_Data;
+
+end Terminal_Interface.Curses.Menus.Menu_User_Data;
diff --git a/Ada95/src/terminal_interface-curses-menus.adb b/Ada95/src/terminal_interface-curses-menus.adb
new file mode 100644
index 0000000..0b24c74
--- /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-2004,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.26 $
+-- $Date: 2008/07/26 18:50: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 : in Menu_Request_Code;
+ Name : out String)
+ is
+ function Request_Name (Key : C_Int) return chars_ptr;
+ pragma Import (C, Request_Name, "menu_request_name");
+ begin
+ Fill_String (Request_Name (C_Int (Key)), Name);
+ end Request_Name;
+
+ function Request_Name (Key : Menu_Request_Code) return String
+ is
+ function Request_Name (Key : C_Int) return chars_ptr;
+ pragma Import (C, Request_Name, "menu_request_name");
+ begin
+ return Fill_String (Request_Name (C_Int (Key)));
+ end Request_Name;
+
+ function Create (Name : String;
+ Description : String := "") return Item
+ is
+ type Char_Ptr is access all Interfaces.C.char;
+ function Newitem (Name, Desc : Char_Ptr) return Item;
+ pragma Import (C, Newitem, "new_item");
+
+ type Name_String is new char_array (0 .. Name'Length);
+ type Name_String_Ptr is access Name_String;
+ pragma Controlled (Name_String_Ptr);
+
+ type Desc_String is new char_array (0 .. Description'Length);
+ type Desc_String_Ptr is access Desc_String;
+ pragma Controlled (Desc_String_Ptr);
+
+ Name_Str : 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 : in Item;
+ Value : in Boolean := True)
+ is
+ function Set_Item_Val (Itm : Item;
+ Val : C_Int) return C_Int;
+ pragma Import (C, Set_Item_Val, "set_item_value");
+
+ Res : constant Eti_Error := Set_Item_Val (Itm, Boolean'Pos (Value));
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Value;
+
+ function Value (Itm : Item) return Boolean
+ is
+ function Item_Val (Itm : Item) return C_Int;
+ pragma Import (C, Item_Val, "item_value");
+ begin
+ if Item_Val (Itm) = Curses_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Value;
+
+-------------------------------------------------------------------------------
+ function Visible (Itm : Item) return Boolean
+ is
+ function Item_Vis (Itm : Item) return C_Int;
+ pragma Import (C, Item_Vis, "item_visible");
+ begin
+ if Item_Vis (Itm) = Curses_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Visible;
+-------------------------------------------------------------------------------
+ procedure Set_Options (Itm : in Item;
+ Options : in Item_Option_Set)
+ is
+ function Set_Item_Opts (Itm : Item;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Set_Item_Opts, "set_item_opts");
+
+ Opt : 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 : in Item;
+ Options : in Item_Option_Set;
+ On : Boolean := True)
+ is
+ function Item_Opts_On (Itm : Item;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Item_Opts_On, "item_opts_on");
+ function Item_Opts_Off (Itm : Item;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Item_Opts_Off, "item_opts_off");
+
+ Opt : 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 : in 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 : in Item;
+ Name : out String)
+ is
+ function Itemname (Itm : Item) return chars_ptr;
+ pragma Import (C, Itemname, "item_name");
+ begin
+ Fill_String (Itemname (Itm), Name);
+ end Name;
+
+ function Name (Itm : in Item) return String
+ is
+ function Itemname (Itm : Item) return chars_ptr;
+ pragma Import (C, Itemname, "item_name");
+ begin
+ return Fill_String (Itemname (Itm));
+ end Name;
+
+ procedure Description (Itm : in Item;
+ Description : out String)
+ is
+ function Descname (Itm : Item) return chars_ptr;
+ pragma Import (C, Descname, "item_description");
+ begin
+ Fill_String (Descname (Itm), Description);
+ end Description;
+
+ function Description (Itm : in Item) return String
+ is
+ function Descname (Itm : Item) return chars_ptr;
+ pragma Import (C, Descname, "item_description");
+ begin
+ return Fill_String (Descname (Itm));
+ end Description;
+-------------------------------------------------------------------------------
+ procedure Set_Current (Men : in Menu;
+ Itm : in Item)
+ is
+ function Set_Curr_Item (Men : Menu;
+ Itm : Item) return C_Int;
+ pragma Import (C, Set_Curr_Item, "set_current_item");
+
+ Res : constant Eti_Error := Set_Curr_Item (Men, Itm);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Current;
+
+ function Current (Men : Menu) return Item
+ is
+ function Curr_Item (Men : Menu) return Item;
+ pragma Import (C, Curr_Item, "current_item");
+
+ Res : constant Item := Curr_Item (Men);
+ begin
+ if Res = Null_Item then
+ raise Menu_Exception;
+ end if;
+ return Res;
+ end Current;
+
+ procedure Set_Top_Row (Men : in Menu;
+ Line : in Line_Position)
+ is
+ function Set_Toprow (Men : Menu;
+ Line : C_Int) return C_Int;
+ pragma Import (C, Set_Toprow, "set_top_row");
+
+ Res : constant Eti_Error := Set_Toprow (Men, C_Int (Line));
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Top_Row;
+
+ function Top_Row (Men : Menu) return Line_Position
+ is
+ function Toprow (Men : Menu) return C_Int;
+ pragma Import (C, Toprow, "top_row");
+
+ Res : constant C_Int := Toprow (Men);
+ begin
+ if Res = Curses_Err then
+ raise Menu_Exception;
+ end if;
+ return Line_Position (Res);
+ end Top_Row;
+
+ function Get_Index (Itm : Item) return Positive
+ is
+ function Get_Itemindex (Itm : Item) return C_Int;
+ pragma Import (C, Get_Itemindex, "item_index");
+
+ Res : constant C_Int := Get_Itemindex (Itm);
+ begin
+ if Res = Curses_Err then
+ raise Menu_Exception;
+ end if;
+ return Positive (Natural (Res) + Positive'First);
+ end Get_Index;
+-------------------------------------------------------------------------------
+ procedure Post (Men : in Menu;
+ Post : in Boolean := True)
+ is
+ function M_Post (Men : Menu) return C_Int;
+ pragma Import (C, M_Post, "post_menu");
+ function M_Unpost (Men : Menu) return C_Int;
+ pragma Import (C, M_Unpost, "unpost_menu");
+
+ Res : Eti_Error;
+ begin
+ if Post then
+ Res := M_Post (Men);
+ else
+ Res := M_Unpost (Men);
+ end if;
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Post;
+-------------------------------------------------------------------------------
+ procedure Set_Options (Men : in Menu;
+ Options : in Menu_Option_Set)
+ is
+ function Set_Menu_Opts (Men : Menu;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Set_Menu_Opts, "set_menu_opts");
+
+ Opt : 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 : in Menu;
+ Options : in Menu_Option_Set;
+ On : in Boolean := True)
+ is
+ function Menu_Opts_On (Men : Menu;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Menu_Opts_On, "menu_opts_on");
+ function Menu_Opts_Off (Men : Menu;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Menu_Opts_Off, "menu_opts_off");
+
+ Opt : 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 : in 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 : in Menu;
+ Win : in Window)
+ is
+ function Set_Menu_Win (Men : Menu;
+ Win : Window) return C_Int;
+ pragma Import (C, Set_Menu_Win, "set_menu_win");
+
+ Res : constant Eti_Error := Set_Menu_Win (Men, Win);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Window;
+
+ function Get_Window (Men : Menu) return Window
+ is
+ function Menu_Win (Men : Menu) return Window;
+ pragma Import (C, Menu_Win, "menu_win");
+
+ W : constant Window := Menu_Win (Men);
+ begin
+ return W;
+ end Get_Window;
+
+ procedure Set_Sub_Window (Men : in Menu;
+ Win : in Window)
+ is
+ function Set_Menu_Sub (Men : Menu;
+ Win : Window) return C_Int;
+ pragma Import (C, Set_Menu_Sub, "set_menu_sub");
+
+ Res : constant Eti_Error := Set_Menu_Sub (Men, Win);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Sub_Window;
+
+ function Get_Sub_Window (Men : Menu) return Window
+ is
+ function Menu_Sub (Men : Menu) return Window;
+ pragma Import (C, Menu_Sub, "menu_sub");
+
+ W : constant Window := Menu_Sub (Men);
+ begin
+ return W;
+ end Get_Sub_Window;
+
+ procedure Scale (Men : in Menu;
+ Lines : out Line_Count;
+ Columns : out Column_Count)
+ is
+ type C_Int_Access is access all C_Int;
+ function M_Scale (Men : Menu;
+ Yp, Xp : C_Int_Access) return C_Int;
+ pragma Import (C, M_Scale, "scale_menu");
+
+ X, Y : aliased C_Int;
+ Res : constant Eti_Error := M_Scale (Men, Y'Access, X'Access);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ Lines := Line_Count (Y);
+ Columns := Column_Count (X);
+ end Scale;
+-------------------------------------------------------------------------------
+ procedure Position_Cursor (Men : Menu)
+ is
+ function Pos_Menu_Cursor (Men : Menu) return C_Int;
+ pragma Import (C, Pos_Menu_Cursor, "pos_menu_cursor");
+
+ Res : constant Eti_Error := Pos_Menu_Cursor (Men);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Position_Cursor;
+
+-------------------------------------------------------------------------------
+ procedure Set_Mark (Men : in Menu;
+ Mark : in String)
+ is
+ type Char_Ptr is access all Interfaces.C.char;
+ function Set_Mark (Men : Menu;
+ Mark : Char_Ptr) return C_Int;
+ pragma Import (C, Set_Mark, "set_menu_mark");
+
+ Txt : char_array (0 .. Mark'Length);
+ Len : size_t;
+ Res : Eti_Error;
+ begin
+ To_C (Mark, Txt, Len);
+ Res := Set_Mark (Men, Txt (Txt'First)'Access);
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Mark;
+
+ procedure Mark (Men : in Menu;
+ Mark : out String)
+ is
+ function Get_Menu_Mark (Men : Menu) return chars_ptr;
+ pragma Import (C, Get_Menu_Mark, "menu_mark");
+ begin
+ Fill_String (Get_Menu_Mark (Men), Mark);
+ end Mark;
+
+ function Mark (Men : Menu) return String
+ is
+ function Get_Menu_Mark (Men : Menu) return chars_ptr;
+ pragma Import (C, Get_Menu_Mark, "menu_mark");
+ begin
+ return Fill_String (Get_Menu_Mark (Men));
+ end Mark;
+
+-------------------------------------------------------------------------------
+ procedure Set_Foreground
+ (Men : in Menu;
+ Fore : in Character_Attribute_Set := Normal_Video;
+ Color : in Color_Pair := Color_Pair'First)
+ is
+ function Set_Menu_Fore (Men : Menu;
+ Attr : C_Chtype) return C_Int;
+ pragma Import (C, Set_Menu_Fore, "set_menu_fore");
+
+ Ch : constant Attributed_Character := (Ch => Character'First,
+ Color => Color,
+ Attr => Fore);
+ Res : constant Eti_Error := Set_Menu_Fore (Men, AttrChar_To_Chtype (Ch));
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Foreground;
+
+ procedure Foreground (Men : in Menu;
+ Fore : out Character_Attribute_Set)
+ is
+ function Menu_Fore (Men : Menu) return C_Chtype;
+ pragma Import (C, Menu_Fore, "menu_fore");
+ begin
+ Fore := Chtype_To_AttrChar (Menu_Fore (Men)).Attr;
+ end Foreground;
+
+ procedure Foreground (Men : in Menu;
+ Fore : out Character_Attribute_Set;
+ Color : out Color_Pair)
+ is
+ function Menu_Fore (Men : Menu) return C_Chtype;
+ pragma Import (C, Menu_Fore, "menu_fore");
+ begin
+ Fore := Chtype_To_AttrChar (Menu_Fore (Men)).Attr;
+ Color := Chtype_To_AttrChar (Menu_Fore (Men)).Color;
+ end Foreground;
+
+ procedure Set_Background
+ (Men : in Menu;
+ Back : in Character_Attribute_Set := Normal_Video;
+ Color : in Color_Pair := Color_Pair'First)
+ is
+ function Set_Menu_Back (Men : Menu;
+ Attr : C_Chtype) return C_Int;
+ pragma Import (C, Set_Menu_Back, "set_menu_back");
+
+ Ch : constant Attributed_Character := (Ch => Character'First,
+ Color => Color,
+ Attr => Back);
+ Res : constant Eti_Error := Set_Menu_Back (Men, AttrChar_To_Chtype (Ch));
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Background;
+
+ procedure Background (Men : in Menu;
+ Back : out Character_Attribute_Set)
+ is
+ function Menu_Back (Men : Menu) return C_Chtype;
+ pragma Import (C, Menu_Back, "menu_back");
+ begin
+ Back := Chtype_To_AttrChar (Menu_Back (Men)).Attr;
+ end Background;
+
+ procedure Background (Men : in Menu;
+ Back : out Character_Attribute_Set;
+ Color : out Color_Pair)
+ is
+ function Menu_Back (Men : Menu) return C_Chtype;
+ pragma Import (C, Menu_Back, "menu_back");
+ begin
+ Back := Chtype_To_AttrChar (Menu_Back (Men)).Attr;
+ Color := Chtype_To_AttrChar (Menu_Back (Men)).Color;
+ end Background;
+
+ procedure Set_Grey (Men : in Menu;
+ Grey : in Character_Attribute_Set := Normal_Video;
+ Color : in Color_Pair := Color_Pair'First)
+ is
+ function Set_Menu_Grey (Men : Menu;
+ Attr : C_Chtype) return C_Int;
+ pragma Import (C, Set_Menu_Grey, "set_menu_grey");
+
+ Ch : constant Attributed_Character := (Ch => Character'First,
+ Color => Color,
+ Attr => Grey);
+
+ Res : constant Eti_Error := Set_Menu_Grey (Men, AttrChar_To_Chtype (Ch));
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Grey;
+
+ procedure Grey (Men : in Menu;
+ Grey : out Character_Attribute_Set)
+ is
+ function Menu_Grey (Men : Menu) return C_Chtype;
+ pragma Import (C, Menu_Grey, "menu_grey");
+ begin
+ Grey := Chtype_To_AttrChar (Menu_Grey (Men)).Attr;
+ end Grey;
+
+ procedure Grey (Men : in Menu;
+ Grey : out Character_Attribute_Set;
+ Color : out Color_Pair)
+ is
+ function Menu_Grey (Men : Menu) return C_Chtype;
+ pragma Import (C, Menu_Grey, "menu_grey");
+ begin
+ Grey := Chtype_To_AttrChar (Menu_Grey (Men)).Attr;
+ Color := Chtype_To_AttrChar (Menu_Grey (Men)).Color;
+ end Grey;
+
+ procedure Set_Pad_Character (Men : in Menu;
+ Pad : in Character := Space)
+ is
+ function Set_Menu_Pad (Men : Menu;
+ Ch : C_Int) return C_Int;
+ pragma Import (C, Set_Menu_Pad, "set_menu_pad");
+
+ Res : constant Eti_Error := Set_Menu_Pad (Men,
+ C_Int (Character'Pos (Pad)));
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Pad_Character;
+
+ procedure Pad_Character (Men : in Menu;
+ Pad : out Character)
+ is
+ function Menu_Pad (Men : Menu) return C_Int;
+ pragma Import (C, Menu_Pad, "menu_pad");
+ begin
+ Pad := Character'Val (Menu_Pad (Men));
+ end Pad_Character;
+-------------------------------------------------------------------------------
+ procedure Set_Spacing (Men : in Menu;
+ Descr : in Column_Position := 0;
+ Row : in Line_Position := 0;
+ Col : in Column_Position := 0)
+ is
+ function Set_Spacing (Men : Menu;
+ D, R, C : C_Int) return C_Int;
+ pragma Import (C, Set_Spacing, "set_menu_spacing");
+
+ Res : constant Eti_Error := Set_Spacing (Men,
+ C_Int (Descr),
+ C_Int (Row),
+ C_Int (Col));
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Spacing;
+
+ procedure Spacing (Men : in Menu;
+ Descr : out Column_Position;
+ Row : out Line_Position;
+ Col : out Column_Position)
+ is
+ type C_Int_Access is access all C_Int;
+ function Get_Spacing (Men : Menu;
+ D, R, C : C_Int_Access) return C_Int;
+ pragma Import (C, Get_Spacing, "menu_spacing");
+
+ D, R, C : aliased C_Int;
+ Res : constant Eti_Error := Get_Spacing (Men,
+ D'Access,
+ R'Access,
+ C'Access);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ else
+ Descr := Column_Position (D);
+ Row := Line_Position (R);
+ Col := Column_Position (C);
+ end if;
+ end Spacing;
+-------------------------------------------------------------------------------
+ function Set_Pattern (Men : Menu;
+ Text : String) return Boolean
+ is
+ type Char_Ptr is access all Interfaces.C.char;
+ function Set_Pattern (Men : Menu;
+ Pattern : Char_Ptr) return C_Int;
+ pragma Import (C, Set_Pattern, "set_menu_pattern");
+
+ S : char_array (0 .. Text'Length);
+ L : size_t;
+ Res : Eti_Error;
+ begin
+ To_C (Text, S, L);
+ Res := Set_Pattern (Men, S (S'First)'Access);
+ case Res is
+ when E_No_Match => return False;
+ when E_Ok => return True;
+ when others =>
+ Eti_Exception (Res);
+ return False;
+ end case;
+ end Set_Pattern;
+
+ procedure Pattern (Men : in Menu;
+ Text : out String)
+ is
+ function Get_Pattern (Men : Menu) return chars_ptr;
+ pragma Import (C, Get_Pattern, "menu_pattern");
+ begin
+ Fill_String (Get_Pattern (Men), Text);
+ end Pattern;
+-------------------------------------------------------------------------------
+ procedure Set_Format (Men : in Menu;
+ Lines : in Line_Count;
+ Columns : in Column_Count)
+ is
+ function Set_Menu_Fmt (Men : Menu;
+ Lin : C_Int;
+ Col : C_Int) return C_Int;
+ pragma Import (C, Set_Menu_Fmt, "set_menu_format");
+
+ Res : constant Eti_Error := Set_Menu_Fmt (Men,
+ C_Int (Lines),
+ C_Int (Columns));
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Format;
+
+ procedure Format (Men : in Menu;
+ Lines : out Line_Count;
+ Columns : out Column_Count)
+ is
+ type C_Int_Access is access all C_Int;
+ function Menu_Fmt (Men : Menu;
+ Y, X : C_Int_Access) return C_Int;
+ pragma Import (C, Menu_Fmt, "menu_format");
+
+ L, C : aliased C_Int;
+ Res : constant Eti_Error := Menu_Fmt (Men, L'Access, C'Access);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ else
+ Lines := Line_Count (L);
+ Columns := Column_Count (C);
+ end if;
+ end Format;
+-------------------------------------------------------------------------------
+ procedure Set_Item_Init_Hook (Men : in Menu;
+ Proc : in Menu_Hook_Function)
+ is
+ function Set_Item_Init (Men : Menu;
+ Proc : Menu_Hook_Function) return C_Int;
+ pragma Import (C, Set_Item_Init, "set_item_init");
+
+ Res : constant Eti_Error := Set_Item_Init (Men, Proc);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Item_Init_Hook;
+
+ procedure Set_Item_Term_Hook (Men : in Menu;
+ Proc : in Menu_Hook_Function)
+ is
+ function Set_Item_Term (Men : Menu;
+ Proc : Menu_Hook_Function) return C_Int;
+ pragma Import (C, Set_Item_Term, "set_item_term");
+
+ Res : constant Eti_Error := Set_Item_Term (Men, Proc);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Item_Term_Hook;
+
+ procedure Set_Menu_Init_Hook (Men : in Menu;
+ Proc : in Menu_Hook_Function)
+ is
+ function Set_Menu_Init (Men : Menu;
+ Proc : Menu_Hook_Function) return C_Int;
+ pragma Import (C, Set_Menu_Init, "set_menu_init");
+
+ Res : constant Eti_Error := Set_Menu_Init (Men, Proc);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Menu_Init_Hook;
+
+ procedure Set_Menu_Term_Hook (Men : in Menu;
+ Proc : in Menu_Hook_Function)
+ is
+ function Set_Menu_Term (Men : Menu;
+ Proc : Menu_Hook_Function) return C_Int;
+ pragma Import (C, Set_Menu_Term, "set_menu_term");
+
+ Res : constant Eti_Error := Set_Menu_Term (Men, Proc);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Menu_Term_Hook;
+
+ function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function
+ is
+ function Item_Init (Men : Menu) return Menu_Hook_Function;
+ pragma Import (C, Item_Init, "item_init");
+ begin
+ return Item_Init (Men);
+ end Get_Item_Init_Hook;
+
+ function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function
+ is
+ function Item_Term (Men : Menu) return Menu_Hook_Function;
+ pragma Import (C, Item_Term, "item_term");
+ begin
+ return Item_Term (Men);
+ end Get_Item_Term_Hook;
+
+ function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function
+ is
+ function Menu_Init (Men : Menu) return Menu_Hook_Function;
+ pragma Import (C, Menu_Init, "menu_init");
+ begin
+ return Menu_Init (Men);
+ end Get_Menu_Init_Hook;
+
+ function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function
+ is
+ function Menu_Term (Men : Menu) return Menu_Hook_Function;
+ pragma Import (C, Menu_Term, "menu_term");
+ begin
+ return Menu_Term (Men);
+ end Get_Menu_Term_Hook;
+-------------------------------------------------------------------------------
+ procedure Redefine (Men : in Menu;
+ Items : in Item_Array_Access)
+ is
+ function Set_Items (Men : Menu;
+ Items : System.Address) return C_Int;
+ pragma Import (C, Set_Items, "set_menu_items");
+
+ Res : Eti_Error;
+ begin
+ pragma Assert (Items (Items'Last) = Null_Item);
+ if Items (Items'Last) /= Null_Item then
+ raise Menu_Exception;
+ else
+ Res := Set_Items (Men, Items.all'Address);
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end if;
+ end Redefine;
+
+ function Item_Count (Men : Menu) return Natural
+ is
+ function Count (Men : Menu) return C_Int;
+ pragma Import (C, Count, "item_count");
+ begin
+ return Natural (Count (Men));
+ end Item_Count;
+
+ function Items (Men : Menu;
+ Index : Positive) return Item
+ is
+ use I_Array;
+
+ function C_Mitems (Men : Menu) return Pointer;
+ pragma Import (C, C_Mitems, "menu_items");
+
+ P : Pointer := C_Mitems (Men);
+ begin
+ if P = null or else Index > 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 : in Boolean := False)
+ is
+ procedure Release is new Ada.Unchecked_Deallocation
+ (Item_Array, Item_Array_Access);
+ begin
+ if IA /= null and then Free_Items then
+ for I in IA'First .. (IA'Last - 1) loop
+ if IA (I) /= Null_Item then
+ Delete (IA (I));
+ end if;
+ end loop;
+ end if;
+ Release (IA);
+ end Free;
+
+-------------------------------------------------------------------------------
+ function Default_Menu_Options return Menu_Option_Set
+ is
+ begin
+ return Get_Options (Null_Menu);
+ end Default_Menu_Options;
+
+ function Default_Item_Options return Item_Option_Set
+ is
+ begin
+ return Get_Options (Null_Item);
+ end Default_Item_Options;
+-------------------------------------------------------------------------------
+
+end Terminal_Interface.Curses.Menus;
diff --git a/Ada95/src/terminal_interface-curses-mouse.adb b/Ada95/src/terminal_interface-curses-mouse.adb
new file mode 100644
index 0000000..fa4c69d
--- /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-2004,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.22 $
+-- $Date: 2008/07/26 18:51:11 $
+-- 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, "_nc_has_mouse");
+ begin
+ if Has_Key (Key_Mouse) or else Mouse_Avail /= 0 then
+ return True;
+ else
+ return False;
+ end if;
+ end Has_Mouse;
+
+ function Get_Mouse return Mouse_Event
+ is
+ type Event_Access is access all Mouse_Event;
+
+ function Getmouse (Ev : Event_Access) return C_Int;
+ pragma Import (C, Getmouse, "getmouse");
+
+ Event : aliased Mouse_Event;
+ begin
+ if Getmouse (Event'Access) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ return Event;
+ end Get_Mouse;
+
+ procedure Register_Reportable_Event (Button : in Mouse_Button;
+ State : in Button_State;
+ Mask : in out Event_Mask)
+ is
+ Button_Nr : constant Natural := Mouse_Button'Pos (Button);
+ State_Nr : constant Natural := Button_State'Pos (State);
+ begin
+ if Button in Modifier_Keys and then State /= Pressed then
+ raise Curses_Exception;
+ else
+ if Button in Real_Buttons then
+ Mask := Mask or ((2 ** (6 * Button_Nr)) ** State_Nr);
+ else
+ Mask := Mask or (BUTTON_CTRL ** (Button_Nr - 4));
+ end if;
+ end if;
+ end Register_Reportable_Event;
+
+ procedure Register_Reportable_Events (Button : in Mouse_Button;
+ State : in Button_States;
+ Mask : in out Event_Mask)
+ is
+ begin
+ for S in Button_States'Range loop
+ if State (S) then
+ Register_Reportable_Event (Button, S, Mask);
+ end if;
+ end loop;
+ end Register_Reportable_Events;
+
+ function Start_Mouse (Mask : Event_Mask := All_Events)
+ return Event_Mask
+ is
+ function MMask (M : Event_Mask;
+ O : access Event_Mask) return Event_Mask;
+ pragma Import (C, MMask, "mousemask");
+ R : Event_Mask;
+ Old : aliased Event_Mask;
+ begin
+ R := MMask (Mask, Old'Access);
+ if R = No_Events then
+ Beep;
+ end if;
+ return Old;
+ end Start_Mouse;
+
+ procedure End_Mouse (Mask : in Event_Mask := No_Events)
+ is
+ begin
+ if Mask /= No_Events then
+ Beep;
+ end if;
+ end End_Mouse;
+
+ procedure Dispatch_Event (Mask : in Event_Mask;
+ Button : out Mouse_Button;
+ State : out Button_State);
+
+ procedure Dispatch_Event (Mask : in Event_Mask;
+ Button : out Mouse_Button;
+ State : out Button_State) is
+ L : Event_Mask;
+ begin
+ Button := Alt; -- preset to non real button;
+ if (Mask and BUTTON1_EVENTS) /= 0 then
+ Button := Left;
+ elsif (Mask and BUTTON2_EVENTS) /= 0 then
+ Button := Middle;
+ elsif (Mask and BUTTON3_EVENTS) /= 0 then
+ Button := Right;
+ elsif (Mask and BUTTON4_EVENTS) /= 0 then
+ Button := Button4;
+ end if;
+ if Button in Real_Buttons then
+ L := 2 ** (6 * Mouse_Button'Pos (Button));
+ for I in Button_State'Range loop
+ if (Mask and L) /= 0 then
+ State := I;
+ exit;
+ end if;
+ L := 2 * L;
+ end loop;
+ else
+ State := Pressed;
+ if (Mask and BUTTON_CTRL) /= 0 then
+ Button := Control;
+ elsif (Mask and BUTTON_SHIFT) /= 0 then
+ Button := Shift;
+ elsif (Mask and BUTTON_ALT) /= 0 then
+ Button := Alt;
+ end if;
+ end if;
+ end Dispatch_Event;
+
+ procedure Get_Event (Event : in Mouse_Event;
+ Y : out Line_Position;
+ X : out Column_Position;
+ Button : out Mouse_Button;
+ State : out Button_State)
+ is
+ Mask : constant Event_Mask := Event.Bstate;
+ begin
+ X := Column_Position (Event.X);
+ Y := Line_Position (Event.Y);
+ Dispatch_Event (Mask, Button, State);
+ end Get_Event;
+
+ procedure Unget_Mouse (Event : in Mouse_Event)
+ is
+ function Ungetmouse (Ev : Mouse_Event) return C_Int;
+ pragma Import (C, Ungetmouse, "ungetmouse");
+ begin
+ if Ungetmouse (Event) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Unget_Mouse;
+
+ function Enclosed_In_Window (Win : Window := Standard_Window;
+ Event : Mouse_Event) return Boolean
+ is
+ function Wenclose (Win : Window; Y : C_Int; X : C_Int)
+ return Curses_Bool;
+ pragma Import (C, Wenclose, "wenclose");
+ begin
+ if Wenclose (Win, C_Int (Event.Y), C_Int (Event.X))
+ = Curses_Bool_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Enclosed_In_Window;
+
+ function Mouse_Interval (Msec : Natural := 200) return Natural
+ is
+ function Mouseinterval (Msec : C_Int) return C_Int;
+ pragma Import (C, Mouseinterval, "mouseinterval");
+ begin
+ return Natural (Mouseinterval (C_Int (Msec)));
+ end Mouse_Interval;
+
+end Terminal_Interface.Curses.Mouse;
diff --git a/Ada95/src/terminal_interface-curses-panels-user_data.adb b/Ada95/src/terminal_interface-curses-panels-user_data.adb
new file mode 100644
index 0000000..231efae
--- /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 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 Interfaces.C;
+with Terminal_Interface.Curses.Aux;
+use Terminal_Interface.Curses.Aux;
+with Terminal_Interface.Curses.Panels;
+use Terminal_Interface.Curses.Panels;
+
+package body Terminal_Interface.Curses.Panels.User_Data is
+
+ use type Interfaces.C.int;
+
+ procedure Set_User_Data (Pan : in Panel;
+ Data : in User_Access)
+ is
+ function Set_Panel_Userptr (Pan : Panel;
+ Addr : User_Access) return C_Int;
+ pragma Import (C, Set_Panel_Userptr, "set_panel_userptr");
+ begin
+ if Set_Panel_Userptr (Pan, Data) = Curses_Err then
+ raise Panel_Exception;
+ end if;
+ end Set_User_Data;
+
+ function Get_User_Data (Pan : in Panel) return User_Access
+ is
+ function Panel_Userptr (Pan : Panel) return User_Access;
+ pragma Import (C, Panel_Userptr, "panel_userptr");
+ begin
+ return Panel_Userptr (Pan);
+ end Get_User_Data;
+
+ procedure Get_User_Data (Pan : in Panel;
+ Data : out User_Access)
+ is
+ begin
+ Data := Get_User_Data (Pan);
+ end Get_User_Data;
+
+end Terminal_Interface.Curses.Panels.User_Data;
diff --git a/Ada95/src/terminal_interface-curses-panels.adb b/Ada95/src/terminal_interface-curses-panels.adb
new file mode 100644
index 0000000..d7e18fa
--- /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 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: 2004/08/21 21:37:00 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+with Interfaces.C;
+
+package body Terminal_Interface.Curses.Panels is
+
+ use type Interfaces.C.int;
+
+ function Create (Win : Window) return Panel
+ is
+ function Newpanel (Win : Window) return Panel;
+ pragma Import (C, Newpanel, "new_panel");
+
+ Pan : Panel;
+ begin
+ Pan := Newpanel (Win);
+ if Pan = Null_Panel then
+ raise Panel_Exception;
+ end if;
+ return Pan;
+ end Create;
+
+ procedure Bottom (Pan : in Panel)
+ is
+ function Bottompanel (Pan : Panel) return C_Int;
+ pragma Import (C, Bottompanel, "bottom_panel");
+ begin
+ if Bottompanel (Pan) = Curses_Err then
+ raise Panel_Exception;
+ end if;
+ end Bottom;
+
+ procedure Top (Pan : in Panel)
+ is
+ function Toppanel (Pan : Panel) return C_Int;
+ pragma Import (C, Toppanel, "top_panel");
+ begin
+ if Toppanel (Pan) = Curses_Err then
+ raise Panel_Exception;
+ end if;
+ end Top;
+
+ procedure Show (Pan : in Panel)
+ is
+ function Showpanel (Pan : Panel) return C_Int;
+ pragma Import (C, Showpanel, "show_panel");
+ begin
+ if Showpanel (Pan) = Curses_Err then
+ raise Panel_Exception;
+ end if;
+ end Show;
+
+ procedure Hide (Pan : in Panel)
+ is
+ function Hidepanel (Pan : Panel) return C_Int;
+ pragma Import (C, Hidepanel, "hide_panel");
+ begin
+ if Hidepanel (Pan) = Curses_Err then
+ raise Panel_Exception;
+ end if;
+ end Hide;
+
+ function Get_Window (Pan : Panel) return Window
+ is
+ function Panel_Win (Pan : Panel) return Window;
+ pragma Import (C, Panel_Win, "panel_window");
+
+ Win : constant Window := Panel_Win (Pan);
+ begin
+ if Win = Null_Window then
+ raise Panel_Exception;
+ end if;
+ return Win;
+ end Get_Window;
+
+ procedure Replace (Pan : in Panel;
+ Win : in Window)
+ is
+ function Replace_Pan (Pan : Panel;
+ Win : Window) return C_Int;
+ pragma Import (C, Replace_Pan, "replace_panel");
+ begin
+ if Replace_Pan (Pan, Win) = Curses_Err then
+ raise Panel_Exception;
+ end if;
+ end Replace;
+
+ procedure Move (Pan : in Panel;
+ Line : in Line_Position;
+ Column : in Column_Position)
+ is
+ function Move (Pan : Panel;
+ Line : C_Int;
+ Column : C_Int) return C_Int;
+ pragma Import (C, Move, "move_panel");
+ begin
+ if Move (Pan, C_Int (Line), C_Int (Column)) = Curses_Err then
+ raise Panel_Exception;
+ end if;
+ end Move;
+
+ function Is_Hidden (Pan : Panel) return Boolean
+ is
+ function Panel_Hidden (Pan : Panel) return C_Int;
+ pragma Import (C, Panel_Hidden, "panel_hidden");
+ begin
+ if Panel_Hidden (Pan) = Curses_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Is_Hidden;
+
+ procedure Delete (Pan : in out Panel)
+ is
+ function Del_Panel (Pan : Panel) return C_Int;
+ pragma Import (C, Del_Panel, "del_panel");
+ begin
+ if Del_Panel (Pan) = Curses_Err then
+ raise Panel_Exception;
+ end if;
+ Pan := Null_Panel;
+ end Delete;
+
+end Terminal_Interface.Curses.Panels;
diff --git a/Ada95/src/terminal_interface-curses-putwin.adb b/Ada95/src/terminal_interface-curses-putwin.adb
new file mode 100644
index 0000000..986cd6b
--- /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 0000000..d302bdc
--- /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 0000000..fd3c646
--- /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-2004,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.11 $
+-- $Date: 2006/06/25 14:30:22 $
+-- 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 : in String;
+ Value : out Integer;
+ Result : out Boolean)
+ is
+ function tgetnum (id : char_array) return C_Int;
+ pragma Import (C, tgetnum, "tgetnum");
+ Txt : char_array (0 .. Name'Length);
+ Length : size_t;
+ begin
+ To_C (Name, Txt, Length);
+ Value := Integer (tgetnum (Txt));
+ if Value = -1 then
+ Result := False;
+ else
+ Result := True;
+ end if;
+ end Get_Number;
+
+------------------------------------------------------------------------------
+ procedure Get_String (Name : String;
+ Value : out String;
+ Result : out Boolean)
+ is
+ function tgetstr (id : char_array;
+ buf : char_array) return chars_ptr;
+ pragma Import (C, tgetstr, "tgetstr");
+ Txt : char_array (0 .. Name'Length);
+ Length : size_t;
+ Txt2 : chars_ptr;
+ type t is new char_array (0 .. 1024); -- does it need to be 1024?
+ Return_Buffer : 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 0000000..dd01396
--- /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 0000000..a3fbe25
--- /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-2000,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.5 $
+-- $Date: 2006/06/25 14:30:22 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+with Interfaces.C; use Interfaces.C;
+with Interfaces.C.Strings; use Interfaces.C.Strings;
+with Ada.Unchecked_Conversion;
+
+package body Terminal_Interface.Curses.Terminfo is
+
+ function Is_MinusOne_Pointer (P : in chars_ptr) return Boolean;
+
+ function Is_MinusOne_Pointer (P : in chars_ptr) return Boolean is
+ type Weird_Address is new System.Storage_Elements.Integer_Address;
+ Invalid_Pointer : constant Weird_Address := -1;
+ function To_Weird is new Ada.Unchecked_Conversion
+ (Source => chars_ptr, Target => Weird_Address);
+ begin
+ if To_Weird (P) = Invalid_Pointer then
+ return True;
+ else
+ return False;
+ end if;
+ end Is_MinusOne_Pointer;
+ pragma Inline (Is_MinusOne_Pointer);
+
+------------------------------------------------------------------------------
+ function Get_Flag (Name : String) return Boolean
+ is
+ function tigetflag (id : char_array) return Curses_Bool;
+ pragma Import (C, tigetflag);
+ Txt : char_array (0 .. Name'Length);
+ Length : size_t;
+ begin
+ To_C (Name, Txt, Length);
+ if tigetflag (Txt) = Curses_Bool (Curses_True) then
+ return True;
+ else
+ return False;
+ end if;
+ end Get_Flag;
+
+------------------------------------------------------------------------------
+ procedure Get_String (Name : String;
+ Value : out Terminfo_String;
+ Result : out Boolean)
+ is
+ function tigetstr (id : char_array) return chars_ptr;
+ pragma Import (C, tigetstr, "tigetstr");
+ Txt : char_array (0 .. Name'Length);
+ Length : size_t;
+ Txt2 : chars_ptr;
+ begin
+ To_C (Name, Txt, Length);
+ Txt2 := tigetstr (Txt);
+ if Txt2 = Null_Ptr then
+ Result := False;
+ elsif Is_MinusOne_Pointer (Txt2) then
+ raise Curses_Exception;
+ else
+ Value := Terminfo_String (Fill_String (Txt2));
+ Result := True;
+ end if;
+ end Get_String;
+
+------------------------------------------------------------------------------
+ function Has_String (Name : String) return Boolean
+ is
+ function tigetstr (id : char_array) return chars_ptr;
+ pragma Import (C, tigetstr, "tigetstr");
+ Txt : char_array (0 .. Name'Length);
+ Length : size_t;
+ Txt2 : chars_ptr;
+ begin
+ To_C (Name, Txt, Length);
+ Txt2 := tigetstr (Txt);
+ if Txt2 = Null_Ptr then
+ return False;
+ elsif Is_MinusOne_Pointer (Txt2) then
+ raise Curses_Exception;
+ else
+ return True;
+ end if;
+ end Has_String;
+
+------------------------------------------------------------------------------
+ function Get_Number (Name : String) return Integer is
+ function tigetstr (s : char_array) return C_Int;
+ pragma Import (C, tigetstr);
+ Txt : char_array (0 .. Name'Length);
+ Length : size_t;
+ begin
+ To_C (Name, Txt, Length);
+ return Integer (tigetstr (Txt));
+ end Get_Number;
+
+------------------------------------------------------------------------------
+ procedure Put_String (Str : Terminfo_String;
+ affcnt : Natural := 1;
+ putc : putctype := null) is
+ function tputs (str : char_array;
+ affcnt : C_Int;
+ putc : putctype) return C_Int;
+ function putp (str : char_array) return C_Int;
+ pragma Import (C, tputs);
+ pragma Import (C, putp);
+ Txt : char_array (0 .. Str'Length);
+ Length : size_t;
+ Err : C_Int;
+ begin
+ To_C (String (Str), Txt, Length);
+ if putc = null then
+ Err := putp (Txt);
+ else
+ Err := tputs (Txt, C_Int (affcnt), putc);
+ end if;
+ if Err = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Put_String;
+
+end Terminal_Interface.Curses.Terminfo;
diff --git a/Ada95/src/terminal_interface-curses-terminfo.ads b/Ada95/src/terminal_interface-curses-terminfo.ads
new file mode 100644
index 0000000..fb39bf1
--- /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 0000000..06b4876
--- /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 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: 2006/06/25 14:24:40 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package body Terminal_Interface.Curses.Text_IO.Aux is
+
+ procedure Put_Buf
+ (Win : in Window;
+ Buf : in String;
+ Width : in Field;
+ Signal : in Boolean := True;
+ Ljust : in Boolean := False)
+ is
+ L : Field;
+ Len : Field;
+ W : Field := Width;
+ LC : Line_Count;
+ CC : Column_Count;
+ Y : Line_Position;
+ X : Column_Position;
+
+ procedure Output (From, To : Field);
+
+ procedure Output (From, To : Field)
+ is
+ begin
+ if Len > 0 then
+ if W = 0 then
+ W := Len;
+ end if;
+ if Len > W then
+ -- LRM A10.6 (7) says this
+ W := Len;
+ end if;
+
+ pragma Assert (Len <= W);
+ Get_Size (Win, LC, CC);
+ if Column_Count (Len) > CC then
+ if Signal then
+ raise Layout_Error;
+ else
+ return;
+ end if;
+ else
+ if Len < W and then not Ljust then
+ declare
+ Filler : constant String (1 .. (W - Len))
+ := (others => ' ');
+ begin
+ Put (Win, Filler);
+ end;
+ end if;
+ Get_Cursor_Position (Win, Y, X);
+ if (X + Column_Position (Len)) > CC then
+ New_Line (Win);
+ end if;
+ Put (Win, Buf (From .. To));
+ if Len < W and then Ljust then
+ declare
+ Filler : constant String (1 .. (W - Len))
+ := (others => ' ');
+ begin
+ Put (Win, Filler);
+ end;
+ end if;
+ end if;
+ end if;
+ end Output;
+
+ begin
+ pragma Assert (Win /= Null_Window);
+ if Ljust then
+ L := 1;
+ for I in 1 .. Buf'Length loop
+ exit when Buf (L) = ' ';
+ L := L + 1;
+ end loop;
+ Len := L - 1;
+ Output (1, Len);
+ else -- input buffer is not left justified
+ L := Buf'Length;
+ for I in 1 .. Buf'Length loop
+ exit when Buf (L) = ' ';
+ L := L - 1;
+ end loop;
+ Len := Buf'Length - L;
+ Output (L + 1, Buf'Length);
+ end if;
+ end Put_Buf;
+
+end Terminal_Interface.Curses.Text_IO.Aux;
diff --git a/Ada95/src/terminal_interface-curses-text_io-aux.ads b/Ada95/src/terminal_interface-curses-text_io-aux.ads
new file mode 100644
index 0000000..df8a9bd
--- /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 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: 2006/06/25 14:24:40 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+private package Terminal_Interface.Curses.Text_IO.Aux is
+ -- pragma Preelaborate (Aux);
+
+ -- This routine is called from the Text_IO output routines for numeric
+ -- and enumeration types.
+ --
+ procedure Put_Buf
+ (Win : in Window; -- The output window
+ Buf : in String; -- The buffer containing the text
+ Width : in Field; -- The width of the output field
+ Signal : in Boolean := True; -- If true, we raise Layout_Error
+ Ljust : in Boolean := False); -- The Buf is left justified
+
+end Terminal_Interface.Curses.Text_IO.Aux;
diff --git a/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 0000000..3b5871e
--- /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 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
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses.Text_IO.Float_IO;
+
+package body Terminal_Interface.Curses.Text_IO.Complex_IO is
+
+ package FIO is new
+ Terminal_Interface.Curses.Text_IO.Float_IO (Complex_Types.Real'Base);
+
+ procedure Put
+ (Win : in Window;
+ Item : in Complex;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp)
+ is
+ begin
+ Put (Win, '(');
+ FIO.Put (Win, Item.Re, Fore, Aft, Exp);
+ Put (Win, ',');
+ FIO.Put (Win, Item.Im, Fore, Aft, Exp);
+ Put (Win, ')');
+ end Put;
+
+ procedure Put
+ (Item : in Complex;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp)
+ is
+ begin
+ Put (Get_Window, Item, Fore, Aft, Exp);
+ end Put;
+
+end Terminal_Interface.Curses.Text_IO.Complex_IO;
diff --git a/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 0000000..233eb3c
--- /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 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
+------------------------------------------------------------------------------
+with Ada.Numerics.Generic_Complex_Types;
+
+generic
+ with package Complex_Types is new Ada.Numerics.Generic_Complex_Types (<>);
+
+package Terminal_Interface.Curses.Text_IO.Complex_IO is
+
+ use Complex_Types;
+
+ Default_Fore : Field := 2;
+ Default_Aft : Field := Real'Digits - 1;
+ Default_Exp : Field := 3;
+
+ procedure Put
+ (Win : in Window;
+ Item : in Complex;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp);
+
+ procedure Put
+ (Item : in Complex;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp);
+
+private
+ pragma Inline (Put);
+
+end Terminal_Interface.Curses.Text_IO.Complex_IO;
diff --git a/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 0000000..02068a0
--- /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 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
+------------------------------------------------------------------------------
+with Ada.Text_IO;
+with Terminal_Interface.Curses.Text_IO.Aux;
+
+package body Terminal_Interface.Curses.Text_IO.Decimal_IO is
+
+ package Aux renames Terminal_Interface.Curses.Text_IO.Aux;
+ package DIO is new Ada.Text_IO.Decimal_IO (Num);
+
+ procedure Put
+ (Win : in Window;
+ Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp)
+ is
+ Buf : String (1 .. Field'Last);
+ Len : Field := Fore + 1 + Aft;
+ begin
+ if Exp > 0 then
+ Len := Len + 1 + Exp;
+ end if;
+ DIO.Put (Buf, Item, Aft, Exp);
+ Aux.Put_Buf (Win, Buf, Len, False);
+ end Put;
+
+ procedure Put
+ (Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp) is
+ begin
+ Put (Get_Window, Item, Fore, Aft, Exp);
+ end Put;
+
+end Terminal_Interface.Curses.Text_IO.Decimal_IO;
diff --git a/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 0000000..6f6fe75
--- /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 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
+------------------------------------------------------------------------------
+generic
+ type Num is delta <> digits <>;
+
+package Terminal_Interface.Curses.Text_IO.Decimal_IO is
+
+ Default_Fore : Field := Num'Fore;
+ Default_Aft : Field := Num'Aft;
+ Default_Exp : Field := 0;
+
+ procedure Put
+ (Win : in Window;
+ Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp);
+
+ procedure Put
+ (Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp);
+
+private
+ pragma Inline (Put);
+
+end Terminal_Interface.Curses.Text_IO.Decimal_IO;
diff --git a/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 0000000..528873a
--- /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 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
+------------------------------------------------------------------------------
+with Ada.Text_IO;
+with Ada.Characters.Handling; use Ada.Characters.Handling;
+with Terminal_Interface.Curses.Text_IO.Aux;
+
+package body Terminal_Interface.Curses.Text_IO.Enumeration_IO is
+
+ package Aux renames Terminal_Interface.Curses.Text_IO.Aux;
+ package EIO is new Ada.Text_IO.Enumeration_IO (Enum);
+
+ procedure Put
+ (Win : in Window;
+ Item : in Enum;
+ Width : in Field := Default_Width;
+ Set : in Type_Set := Default_Setting)
+ is
+ Buf : String (1 .. Field'Last);
+ Tset : Ada.Text_IO.Type_Set;
+ begin
+ if Set /= Mixed_Case then
+ Tset := Ada.Text_IO.Type_Set'Val (Type_Set'Pos (Set));
+ else
+ Tset := Ada.Text_IO.Lower_Case;
+ end if;
+ EIO.Put (Buf, Item, Tset);
+ if Set = Mixed_Case then
+ Buf (Buf'First) := To_Upper (Buf (Buf'First));
+ end if;
+ Aux.Put_Buf (Win, Buf, Width, True, True);
+ end Put;
+
+ procedure Put
+ (Item : in Enum;
+ Width : in Field := Default_Width;
+ Set : in Type_Set := Default_Setting)
+ is
+ begin
+ Put (Get_Window, Item, Width, Set);
+ end Put;
+
+end Terminal_Interface.Curses.Text_IO.Enumeration_IO;
diff --git a/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 0000000..b221d7f
--- /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 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
+------------------------------------------------------------------------------
+generic
+ type Enum is (<>);
+
+package Terminal_Interface.Curses.Text_IO.Enumeration_IO is
+
+ Default_Width : Field := 0;
+ Default_Setting : Type_Set := Mixed_Case;
+
+ procedure Put
+ (Win : in Window;
+ Item : in Enum;
+ Width : in Field := Default_Width;
+ Set : in Type_Set := Default_Setting);
+
+ procedure Put
+ (Item : in Enum;
+ Width : in Field := Default_Width;
+ Set : in Type_Set := Default_Setting);
+
+private
+ pragma Inline (Put);
+
+end Terminal_Interface.Curses.Text_IO.Enumeration_IO;
diff --git a/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 0000000..e74f148
--- /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 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
+------------------------------------------------------------------------------
+with Ada.Text_IO;
+with Terminal_Interface.Curses.Text_IO.Aux;
+
+package body Terminal_Interface.Curses.Text_IO.Fixed_IO is
+
+ package Aux renames Terminal_Interface.Curses.Text_IO.Aux;
+ package FIXIO is new Ada.Text_IO.Fixed_IO (Num);
+
+ procedure Put
+ (Win : in Window;
+ Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp)
+ is
+ Buf : String (1 .. Field'Last);
+ Len : Field := Fore + 1 + Aft;
+ begin
+ if Exp > 0 then
+ Len := Len + 1 + Exp;
+ end if;
+ FIXIO.Put (Buf, Item, Aft, Exp);
+ Aux.Put_Buf (Win, Buf, Len, False);
+ end Put;
+
+ procedure Put
+ (Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp) is
+ begin
+ Put (Get_Window, Item, Fore, Aft, Exp);
+ end Put;
+
+end Terminal_Interface.Curses.Text_IO.Fixed_IO;
diff --git a/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 0000000..4b8b136
--- /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 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
+------------------------------------------------------------------------------
+generic
+ type Num is delta <>;
+
+package Terminal_Interface.Curses.Text_IO.Fixed_IO is
+
+ Default_Fore : Field := Num'Fore;
+ Default_Aft : Field := Num'Aft;
+ Default_Exp : Field := 0;
+
+ procedure Put
+ (Win : in Window;
+ Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp);
+
+ procedure Put
+ (Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp);
+
+private
+ pragma Inline (Put);
+
+end Terminal_Interface.Curses.Text_IO.Fixed_IO;
diff --git a/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 0000000..19d261b
--- /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 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
+------------------------------------------------------------------------------
+with Ada.Text_IO;
+with Terminal_Interface.Curses.Text_IO.Aux;
+
+package body Terminal_Interface.Curses.Text_IO.Float_IO is
+
+ package Aux renames Terminal_Interface.Curses.Text_IO.Aux;
+ package FIO is new Ada.Text_IO.Float_IO (Num);
+
+ procedure Put
+ (Win : in Window;
+ Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp)
+ is
+ Buf : String (1 .. Field'Last);
+ Len : Field := Fore + 1 + Aft;
+ begin
+ if Exp > 0 then
+ Len := Len + 1 + Exp;
+ end if;
+ FIO.Put (Buf, Item, Aft, Exp);
+ Aux.Put_Buf (Win, Buf, Len, False);
+ end Put;
+
+ procedure Put
+ (Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp)
+ is
+ begin
+ Put (Get_Window, Item, Fore, Aft, Exp);
+ end Put;
+
+end Terminal_Interface.Curses.Text_IO.Float_IO;
diff --git a/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 0000000..0856523
--- /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 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
+------------------------------------------------------------------------------
+generic
+ type Num is digits <>;
+
+package Terminal_Interface.Curses.Text_IO.Float_IO is
+
+ Default_Fore : Field := 2;
+ Default_Aft : Field := Num'Digits - 1;
+ Default_Exp : Field := 3;
+
+ procedure Put
+ (Win : in Window;
+ Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp);
+
+ procedure Put
+ (Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp);
+
+private
+ pragma Inline (Put);
+
+end Terminal_Interface.Curses.Text_IO.Float_IO;
diff --git a/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 0000000..e694e08
--- /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 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
+------------------------------------------------------------------------------
+with Ada.Text_IO;
+with Terminal_Interface.Curses.Text_IO.Aux;
+
+package body Terminal_Interface.Curses.Text_IO.Integer_IO is
+
+ package Aux renames Terminal_Interface.Curses.Text_IO.Aux;
+ package IIO is new Ada.Text_IO.Integer_IO (Num);
+
+ procedure Put
+ (Win : in Window;
+ Item : in Num;
+ Width : in Field := Default_Width;
+ Base : in Number_Base := Default_Base)
+ is
+ Buf : String (1 .. Field'Last);
+ begin
+ IIO.Put (Buf, Item, Base);
+ Aux.Put_Buf (Win, Buf, Width);
+ end Put;
+
+ procedure Put
+ (Item : in Num;
+ Width : in Field := Default_Width;
+ Base : in Number_Base := Default_Base)
+ is
+ begin
+ Put (Get_Window, Item, Width, Base);
+ end Put;
+
+end Terminal_Interface.Curses.Text_IO.Integer_IO;
diff --git a/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 0000000..d8b169a
--- /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 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
+------------------------------------------------------------------------------
+generic
+ type Num is range <>;
+
+package Terminal_Interface.Curses.Text_IO.Integer_IO is
+
+ Default_Width : Field := Num'Width;
+ Default_Base : Number_Base := 10;
+
+ procedure Put
+ (Win : in Window;
+ Item : in Num;
+ Width : in Field := Default_Width;
+ Base : in Number_Base := Default_Base);
+
+ procedure Put
+ (Item : in Num;
+ Width : in Field := Default_Width;
+ Base : in Number_Base := Default_Base);
+
+private
+ pragma Inline (Put);
+
+end Terminal_Interface.Curses.Text_IO.Integer_IO;
diff --git a/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 0000000..8cc1d4a
--- /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 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
+------------------------------------------------------------------------------
+with Ada.Text_IO;
+with Terminal_Interface.Curses.Text_IO.Aux;
+
+package body Terminal_Interface.Curses.Text_IO.Modular_IO is
+
+ package Aux renames Terminal_Interface.Curses.Text_IO.Aux;
+ package MIO is new Ada.Text_IO.Modular_IO (Num);
+
+ procedure Put
+ (Win : in Window;
+ Item : in Num;
+ Width : in Field := Default_Width;
+ Base : in Number_Base := Default_Base)
+ is
+ Buf : String (1 .. Field'Last);
+ begin
+ MIO.Put (Buf, Item, Base);
+ Aux.Put_Buf (Win, Buf, Width);
+ end Put;
+
+ procedure Put
+ (Item : in Num;
+ Width : in Field := Default_Width;
+ Base : in Number_Base := Default_Base)
+ is
+ begin
+ Put (Get_Window, Item, Width, Base);
+ end Put;
+
+end Terminal_Interface.Curses.Text_IO.Modular_IO;
diff --git a/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 0000000..618706f
--- /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 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
+------------------------------------------------------------------------------
+generic
+ type Num is mod <>;
+
+package Terminal_Interface.Curses.Text_IO.Modular_IO is
+
+ Default_Width : Field := Num'Width;
+ Default_Base : Number_Base := 10;
+
+ procedure Put
+ (Win : in Window;
+ Item : in Num;
+ Width : in Field := Default_Width;
+ Base : in Number_Base := Default_Base);
+
+ procedure Put
+ (Item : in Num;
+ Width : in Field := Default_Width;
+ Base : in Number_Base := Default_Base);
+
+private
+ pragma Inline (Put);
+
+end Terminal_Interface.Curses.Text_IO.Modular_IO;
diff --git a/Ada95/src/terminal_interface-curses-text_io.adb b/Ada95/src/terminal_interface-curses-text_io.adb
new file mode 100644
index 0000000..255b123
--- /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-2004,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.18 $
+-- $Date: 2006/06/25 14:24:40 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package body Terminal_Interface.Curses.Text_IO is
+
+ Default_Window : Window := Null_Window;
+
+ procedure Set_Window (Win : in Window)
+ is
+ begin
+ Default_Window := Win;
+ end Set_Window;
+
+ function Get_Window return Window
+ is
+ begin
+ if Default_Window = Null_Window then
+ return Standard_Window;
+ else
+ return Default_Window;
+ end if;
+ end Get_Window;
+ pragma Inline (Get_Window);
+
+ procedure Flush (Win : in Window)
+ is
+ begin
+ Refresh (Win);
+ end Flush;
+
+ procedure Flush
+ is
+ begin
+ Flush (Get_Window);
+ end Flush;
+
+ --------------------------------------------
+ -- Specification of line and page lengths --
+ --------------------------------------------
+
+ -- There are no set routines in this package. I assume, that you allocate
+ -- the window with an appropriate size.
+ -- A scroll-window is interpreted as an page with unbounded page length,
+ -- i.e. it returns the conventional 0 as page length.
+
+ function Line_Length (Win : in Window) return Count
+ is
+ N_Lines : Line_Count;
+ N_Cols : Column_Count;
+ begin
+ Get_Size (Win, N_Lines, N_Cols);
+ -- if Natural (N_Cols) > Natural (Count'Last) then
+ -- raise Layout_Error;
+ -- end if;
+ return Count (N_Cols);
+ end Line_Length;
+
+ function Line_Length return Count
+ is
+ begin
+ return Line_Length (Get_Window);
+ end Line_Length;
+
+ function Page_Length (Win : in Window) return Count
+ is
+ N_Lines : Line_Count;
+ N_Cols : Column_Count;
+ begin
+ if Scrolling_Allowed (Win) then
+ return 0;
+ else
+ Get_Size (Win, N_Lines, N_Cols);
+ -- if Natural (N_Lines) > Natural (Count'Last) then
+ -- raise Layout_Error;
+ -- end if;
+ return Count (N_Lines);
+ end if;
+ end Page_Length;
+
+ function Page_Length return Count
+ is
+ begin
+ return Page_Length (Get_Window);
+ end Page_Length;
+
+ ------------------------------------
+ -- Column, Line, and Page Control --
+ ------------------------------------
+ procedure New_Line (Win : in Window; Spacing : in Positive_Count := 1)
+ is
+ P_Size : constant Count := Page_Length (Win);
+ begin
+ if 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 : in Positive_Count := 1)
+ is
+ begin
+ New_Line (Get_Window, Spacing);
+ end New_Line;
+
+ procedure New_Page (Win : in Window)
+ is
+ begin
+ Clear (Win);
+ end New_Page;
+
+ procedure New_Page
+ is
+ begin
+ New_Page (Get_Window);
+ end New_Page;
+
+ procedure Set_Col (Win : in Window; To : in Positive_Count)
+ is
+ Y : Line_Position;
+ X1 : Column_Position;
+ X2 : Column_Position;
+ N : Natural;
+ begin
+ if 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 : in Positive_Count)
+ is
+ begin
+ Set_Col (Get_Window, To);
+ end Set_Col;
+
+ procedure Set_Line (Win : in Window; To : in Positive_Count)
+ is
+ Y1 : Line_Position;
+ Y2 : Line_Position;
+ X : Column_Position;
+ N : Natural;
+ begin
+ if 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 : in Positive_Count)
+ is
+ begin
+ Set_Line (Get_Window, To);
+ end Set_Line;
+
+ function Col (Win : in Window) return Positive_Count
+ is
+ Y : Line_Position;
+ X : Column_Position;
+ N : Natural;
+ begin
+ Get_Cursor_Position (Win, Y, X);
+ N := Natural (X); N := N + 1;
+ -- if N > Natural (Count'Last) then
+ -- raise Layout_Error;
+ -- end if;
+ return Positive_Count (N);
+ end Col;
+
+ function Col return Positive_Count
+ is
+ begin
+ return Col (Get_Window);
+ end Col;
+
+ function Line (Win : in Window) return Positive_Count
+ is
+ Y : Line_Position;
+ X : Column_Position;
+ N : Natural;
+ begin
+ Get_Cursor_Position (Win, Y, X);
+ N := Natural (Y); N := N + 1;
+ -- if N > Natural (Count'Last) then
+ -- raise Layout_Error;
+ -- end if;
+ return Positive_Count (N);
+ end Line;
+
+ function Line return Positive_Count
+ is
+ begin
+ return Line (Get_Window);
+ end Line;
+
+ -----------------------
+ -- Characters Output --
+ -----------------------
+
+ procedure Put (Win : in Window; Item : in Character)
+ is
+ P_Size : constant Count := Page_Length (Win);
+ Y : Line_Position;
+ X : Column_Position;
+ L : Line_Count;
+ C : Column_Count;
+ begin
+ if P_Size > 0 then
+ Get_Cursor_Position (Win, Y, X);
+ Get_Size (Win, L, C);
+ if (Y + 1) = L and then (X + 1) = C then
+ New_Page (Win);
+ end if;
+ end if;
+ Add (Win, Item);
+ end Put;
+
+ procedure Put (Item : in Character)
+ is
+ begin
+ Put (Get_Window, Item);
+ end Put;
+
+ --------------------
+ -- Strings-Output --
+ --------------------
+
+ procedure Put (Win : in Window; Item : in String)
+ is
+ P_Size : constant Count := Page_Length (Win);
+ Y : Line_Position;
+ X : Column_Position;
+ L : Line_Count;
+ C : Column_Count;
+ begin
+ if P_Size > 0 then
+ Get_Cursor_Position (Win, Y, X);
+ Get_Size (Win, L, C);
+ if (Y + 1) = L and then (X + 1 + Item'Length) >= C then
+ New_Page (Win);
+ end if;
+ end if;
+ Add (Win, Item);
+ end Put;
+
+ procedure Put (Item : in String)
+ is
+ begin
+ Put (Get_Window, Item);
+ end Put;
+
+ procedure Put_Line
+ (Win : in Window;
+ Item : in String)
+ is
+ begin
+ Put (Win, Item);
+ New_Line (Win, 1);
+ end Put_Line;
+
+ procedure Put_Line
+ (Item : in String)
+ is
+ begin
+ Put_Line (Get_Window, Item);
+ end Put_Line;
+
+end Terminal_Interface.Curses.Text_IO;
diff --git a/Ada95/src/terminal_interface-curses-text_io.ads b/Ada95/src/terminal_interface-curses-text_io.ads
new file mode 100644
index 0000000..2f6c48a
--- /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 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 Ada.Text_IO;
+with Ada.IO_Exceptions;
+
+package Terminal_Interface.Curses.Text_IO is
+
+ use type Ada.Text_IO.Count;
+ subtype Count is Ada.Text_IO.Count;
+ subtype Positive_Count is Count range 1 .. Count'Last;
+
+ subtype Field is Ada.Text_IO.Field;
+ subtype Number_Base is Integer range 2 .. 16;
+
+ type Type_Set is (Lower_Case, Upper_Case, Mixed_Case);
+
+ -- For most of the routines you will see a version without a Window
+ -- type parameter. They will operate on a default window, which can
+ -- be set by the user. It is initially equal to Standard_Window.
+
+ procedure Set_Window (Win : in Window);
+ -- Set Win as the default window
+
+ function Get_Window return Window;
+ -- Get the current default window
+
+ procedure Flush (Win : in Window);
+ procedure Flush;
+
+ --------------------------------------------
+ -- Specification of line and page lengths --
+ --------------------------------------------
+
+ -- There are no set routines in this package. I assume, that you allocate
+ -- the window with an appropriate size.
+ -- A scroll-window is interpreted as an page with unbounded page length,
+ -- i.e. it returns the conventional 0 as page length.
+
+ function Line_Length (Win : in Window) return Count;
+ function Line_Length return Count;
+
+ function Page_Length (Win : in Window) return Count;
+ function Page_Length return Count;
+
+ ------------------------------------
+ -- Column, Line, and Page Control --
+ ------------------------------------
+ procedure New_Line (Win : in Window; Spacing : in Positive_Count := 1);
+ procedure New_Line (Spacing : in Positive_Count := 1);
+
+ procedure New_Page (Win : in Window);
+ procedure New_Page;
+
+ procedure Set_Col (Win : in Window; To : in Positive_Count);
+ procedure Set_Col (To : in Positive_Count);
+
+ procedure Set_Line (Win : in Window; To : in Positive_Count);
+ procedure Set_Line (To : in Positive_Count);
+
+ function Col (Win : in Window) return Positive_Count;
+ function Col return Positive_Count;
+
+ function Line (Win : in Window) return Positive_Count;
+ function Line return Positive_Count;
+
+ -----------------------
+ -- Characters-Output --
+ -----------------------
+
+ procedure Put (Win : in Window; Item : in Character);
+ procedure Put (Item : in Character);
+
+ --------------------
+ -- Strings-Output --
+ --------------------
+
+ procedure Put (Win : in Window; Item : in String);
+ procedure Put (Item : in String);
+
+ procedure Put_Line
+ (Win : in Window;
+ Item : in String);
+
+ procedure Put_Line
+ (Item : in String);
+
+ -- Exceptions
+
+ Status_Error : exception renames Ada.IO_Exceptions.Status_Error;
+ Mode_Error : exception renames Ada.IO_Exceptions.Mode_Error;
+ Name_Error : exception renames Ada.IO_Exceptions.Name_Error;
+ Use_Error : exception renames Ada.IO_Exceptions.Use_Error;
+ Device_Error : exception renames Ada.IO_Exceptions.Device_Error;
+ End_Error : exception renames Ada.IO_Exceptions.End_Error;
+ Data_Error : exception renames Ada.IO_Exceptions.Data_Error;
+ Layout_Error : exception renames Ada.IO_Exceptions.Layout_Error;
+
+end Terminal_Interface.Curses.Text_IO;
diff --git a/Ada95/src/terminal_interface-curses-trace.adb_p b/Ada95/src/terminal_interface-curses-trace.adb_p
new file mode 100644
index 0000000..747454a
--- /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 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.5 $
+-- 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 0000000..fdaaf9f
--- /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;