aboutsummaryrefslogtreecommitdiff
path: root/Ada95/samples
diff options
context:
space:
mode:
authorEd Schouten <ed@FreeBSD.org>2011-04-30 10:55:14 +0000
committerEd Schouten <ed@FreeBSD.org>2011-04-30 10:55:14 +0000
commit0294a182a1629b1d854b84906e73487d6cb75fba (patch)
treee563e21bcc0164ba11452983316bda26eebb1d3c /Ada95/samples
parent22b11c4db16996bf8d4878fab98762c348676df3 (diff)
downloadsrc-0294a182a1629b1d854b84906e73487d6cb75fba.tar.gz
src-0294a182a1629b1d854b84906e73487d6cb75fba.zip
Import a stock copy of ncurses 5.8 into the vendor space.vendor/ncurses/5.8-20110226
It seems both local changes we made to 5.7 have already been fixed upstream properly, so there is no need to preserve the changes. Also, with SVN we import full source trees. Unlike CVS, where we removed unneeded cruft.
Notes
Notes: svn path=/vendor/ncurses/dist/; revision=221243 svn path=/vendor/ncurses/5.8-20110226/; revision=221244; tag=vendor/ncurses/5.8-20110226
Diffstat (limited to 'Ada95/samples')
-rw-r--r--Ada95/samples/Makefile.in133
-rw-r--r--Ada95/samples/README35
-rw-r--r--Ada95/samples/explain.txt186
-rw-r--r--Ada95/samples/ncurses.adb47
-rw-r--r--Ada95/samples/ncurses2-acs_and_scroll.adb714
-rw-r--r--Ada95/samples/ncurses2-acs_and_scroll.ads41
-rw-r--r--Ada95/samples/ncurses2-acs_display.adb235
-rw-r--r--Ada95/samples/ncurses2-acs_display.ads41
-rw-r--r--Ada95/samples/ncurses2-attr_test.adb362
-rw-r--r--Ada95/samples/ncurses2-attr_test.ads42
-rw-r--r--Ada95/samples/ncurses2-color_edit.adb259
-rw-r--r--Ada95/samples/ncurses2-color_edit.ads41
-rw-r--r--Ada95/samples/ncurses2-color_test.adb163
-rw-r--r--Ada95/samples/ncurses2-color_test.ads41
-rw-r--r--Ada95/samples/ncurses2-demo_forms.adb497
-rw-r--r--Ada95/samples/ncurses2-demo_forms.ads41
-rw-r--r--Ada95/samples/ncurses2-demo_pad.adb675
-rw-r--r--Ada95/samples/ncurses2-demo_pad.ads41
-rw-r--r--Ada95/samples/ncurses2-demo_panels.adb382
-rw-r--r--Ada95/samples/ncurses2-demo_panels.ads41
-rw-r--r--Ada95/samples/ncurses2-flushinp_test.adb135
-rw-r--r--Ada95/samples/ncurses2-flushinp_test.ads43
-rw-r--r--Ada95/samples/ncurses2-genericputs.adb117
-rw-r--r--Ada95/samples/ncurses2-genericputs.ads72
-rw-r--r--Ada95/samples/ncurses2-getch.ads41
-rw-r--r--Ada95/samples/ncurses2-getch_test.adb254
-rw-r--r--Ada95/samples/ncurses2-getch_test.ads41
-rw-r--r--Ada95/samples/ncurses2-getopt.adb163
-rw-r--r--Ada95/samples/ncurses2-getopt.ads60
-rw-r--r--Ada95/samples/ncurses2-m.adb448
-rw-r--r--Ada95/samples/ncurses2-m.ads43
-rw-r--r--Ada95/samples/ncurses2-menu_test.adb168
-rw-r--r--Ada95/samples/ncurses2-menu_test.ads41
-rw-r--r--Ada95/samples/ncurses2-overlap_test.adb157
-rw-r--r--Ada95/samples/ncurses2-overlap_test.ads41
-rw-r--r--Ada95/samples/ncurses2-slk_test.adb174
-rw-r--r--Ada95/samples/ncurses2-slk_test.ads41
-rw-r--r--Ada95/samples/ncurses2-test_sgr_attributes.adb185
-rw-r--r--Ada95/samples/ncurses2-test_sgr_attributes.ads41
-rw-r--r--Ada95/samples/ncurses2-trace_set.adb480
-rw-r--r--Ada95/samples/ncurses2-trace_set.ads41
-rw-r--r--Ada95/samples/ncurses2-util.adb190
-rw-r--r--Ada95/samples/ncurses2-util.ads76
-rw-r--r--Ada95/samples/ncurses2.ads44
-rw-r--r--Ada95/samples/rain.adb179
-rw-r--r--Ada95/samples/rain.ads43
-rw-r--r--Ada95/samples/sample-curses_demo-attributes.adb122
-rw-r--r--Ada95/samples/sample-curses_demo-attributes.ads45
-rw-r--r--Ada95/samples/sample-curses_demo-mouse.adb220
-rw-r--r--Ada95/samples/sample-curses_demo-mouse.ads45
-rw-r--r--Ada95/samples/sample-curses_demo.adb143
-rw-r--r--Ada95/samples/sample-curses_demo.ads45
-rw-r--r--Ada95/samples/sample-explanation.adb408
-rw-r--r--Ada95/samples/sample-explanation.ads59
-rw-r--r--Ada95/samples/sample-form_demo-aux.adb263
-rw-r--r--Ada95/samples/sample-form_demo-aux.ads92
-rw-r--r--Ada95/samples/sample-form_demo-handler.adb98
-rw-r--r--Ada95/samples/sample-form_demo-handler.ads64
-rw-r--r--Ada95/samples/sample-form_demo.adb130
-rw-r--r--Ada95/samples/sample-form_demo.ads45
-rw-r--r--Ada95/samples/sample-function_key_setting.adb214
-rw-r--r--Ada95/samples/sample-function_key_setting.ads82
-rw-r--r--Ada95/samples/sample-header_handler.adb180
-rw-r--r--Ada95/samples/sample-header_handler.ads53
-rw-r--r--Ada95/samples/sample-helpers.adb68
-rw-r--r--Ada95/samples/sample-helpers.ads54
-rw-r--r--Ada95/samples/sample-keyboard_handler.adb194
-rw-r--r--Ada95/samples/sample-keyboard_handler.ads55
-rw-r--r--Ada95/samples/sample-manifest.ads67
-rw-r--r--Ada95/samples/sample-menu_demo-aux.adb204
-rw-r--r--Ada95/samples/sample-menu_demo-aux.ads71
-rw-r--r--Ada95/samples/sample-menu_demo-handler.adb108
-rw-r--r--Ada95/samples/sample-menu_demo-handler.ads64
-rw-r--r--Ada95/samples/sample-menu_demo.adb396
-rw-r--r--Ada95/samples/sample-menu_demo.ads45
-rw-r--r--Ada95/samples/sample-my_field_type.adb68
-rw-r--r--Ada95/samples/sample-my_field_type.ads61
-rw-r--r--Ada95/samples/sample-text_io_demo.adb181
-rw-r--r--Ada95/samples/sample-text_io_demo.ads45
-rw-r--r--Ada95/samples/sample.adb220
-rw-r--r--Ada95/samples/sample.ads43
-rw-r--r--Ada95/samples/status.adb57
-rw-r--r--Ada95/samples/status.ads60
-rw-r--r--Ada95/samples/tour.adb46
-rw-r--r--Ada95/samples/tour.ads41
85 files changed, 11791 insertions, 0 deletions
diff --git a/Ada95/samples/Makefile.in b/Ada95/samples/Makefile.in
new file mode 100644
index 000000000000..3d1554c72111
--- /dev/null
+++ b/Ada95/samples/Makefile.in
@@ -0,0 +1,133 @@
+##############################################################################
+# Copyright (c) 1998-2009,2010 Free Software Foundation, Inc. #
+# #
+# Permission is hereby granted, free of charge, to any person obtaining a #
+# copy of this software and associated documentation files (the "Software"), #
+# to deal in the Software without restriction, including without limitation #
+# the rights to use, copy, modify, merge, publish, distribute, distribute #
+# with modifications, sublicense, and/or sell copies of the Software, and to #
+# permit persons to whom the Software is furnished to do so, subject to the #
+# following conditions: #
+# #
+# The above copyright notice and this permission notice shall be included in #
+# all copies or substantial portions of the Software. #
+# #
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR #
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, #
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL #
+# THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER #
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING #
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER #
+# DEALINGS IN THE SOFTWARE. #
+# #
+# Except as contained in this notice, the name(s) of the above copyright #
+# holders shall not be used in advertising or otherwise to promote the sale, #
+# use or other dealings in this Software without prior written #
+# authorization. #
+##############################################################################
+#
+# Author: Juergen Pfeifer, 1996
+#
+# $Id: Makefile.in,v 1.40 2010/11/27 21:45:27 tom Exp $
+#
+.SUFFIXES:
+
+SHELL = /bin/sh
+VPATH = @srcdir@
+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) -L../lib -lAdaCurses @TEST_LIBS2@
+
+PROGS = tour rain ncurses
+
+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 b~*.ad[bs]
+
+distclean :: clean
+ rm -f Makefile
+
+realclean :: distclean
+ @echo made $@
diff --git a/Ada95/samples/README b/Ada95/samples/README
new file mode 100644
index 000000000000..c4f16ad306dc
--- /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 000000000000..570f617bf926
--- /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 000000000000..19f658d5632c
--- /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 000000000000..5d965983b84e
--- /dev/null
+++ b/Ada95/samples/ncurses2-acs_and_scroll.adb
@@ -0,0 +1,714 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-2008,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.9 $
+-- $Date: 2009/12/26 17:38:58 $
+-- 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;
+
+ -- 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 000000000000..79e4862af0f6
--- /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 000000000000..a71c61d5daff
--- /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 000000000000..4e616c5e1443
--- /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 000000000000..66271042c0bb
--- /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 000000000000..51c51435eab5
--- /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 000000000000..098f98d837b2
--- /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-2006,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.6 $
+-- $Date: 2009/12/26 17:38:58 $
+-- 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 000000000000..3e8e392dfe8e
--- /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 000000000000..c8f6c837ae17
--- /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 000000000000..6e663181a9bc
--- /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 000000000000..7137aa0b1e45
--- /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 000000000000..eabaa01b9e91
--- /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 000000000000..862b8b70da29
--- /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 000000000000..b996263c1cde
--- /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 000000000000..d2558ed47309
--- /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 000000000000..eb2878c8501e
--- /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 000000000000..9ea98e158c34
--- /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 000000000000..5376c94a54b2
--- /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 000000000000..829d08d23a2f
--- /dev/null
+++ b/Ada95/samples/ncurses2-genericputs.adb
@@ -0,0 +1,117 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-2008,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.4 $
+-- $Date: 2009/12/26 17:38:58 $
+-- 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 : Window := Standard_Window;
+ Str : out BS.Bounded_String;
+ Len : 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 : 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 : 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 000000000000..accc3cc63d70
--- /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,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.3 $
+-- $Date: 2009/12/26 17:38:58 $
+-- 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 : Terminal_Interface.Curses.Window
+ := Terminal_Interface.Curses.Standard_Window;
+ Str : out BS.Bounded_String;
+ Len : Integer := -1);
+
+ procedure myPut (Str : out BS.Bounded_String;
+ i : Integer;
+ Base : 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 : 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 000000000000..21a09f3160f2
--- /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 000000000000..2802cfb55017
--- /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-2008,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.8 $
+-- $Date: 2009/12/26 17:38: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 000000000000..78a0a48c172e
--- /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 000000000000..238c43919eac
--- /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 000000000000..a8b356e968d6
--- /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 000000000000..5b20428c20a1
--- /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 000000000000..c32d895dc147
--- /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 000000000000..a4c4807b2812
--- /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 000000000000..17e5b16b3e48
--- /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 000000000000..37e8d4c2eb5a
--- /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 000000000000..ce6e3e696121
--- /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 000000000000..256becf92dac
--- /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-2006,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.8 $
+-- $Date: 2009/12/26 17:38:58 $
+-- 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 : Window := Standard_Window;
+ Str : out Ada.Strings.Unbounded.Unbounded_String;
+ Len : Integer := -1);
+
+ procedure myGet (Win : Window := Standard_Window;
+ Str : out Ada.Strings.Unbounded.Unbounded_String;
+ Len : 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 000000000000..51e95871a97c
--- /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 000000000000..97449a40cafc
--- /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 000000000000..241118094e16
--- /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 000000000000..1e2716e1e25c
--- /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 000000000000..7bbf8ca5450a
--- /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 000000000000..8ae327242ba4
--- /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 000000000000..f46749f06862
--- /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 000000000000..2fe01970899d
--- /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 000000000000..d673018eb036
--- /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 000000000000..3ad1912c5e49
--- /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 000000000000..c49f37d60246
--- /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 000000000000..6d9b4e8df80f
--- /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 000000000000..490685c75076
--- /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 000000000000..ad78d0d0a750
--- /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 000000000000..700da7684be1
--- /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 000000000000..ed4ad0f019f8
--- /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 000000000000..3129dfd76a74
--- /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-2006,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control
+-- $Revision: 1.21 $
+-- $Date: 2009/12/26 17:38:58 $
+-- 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 : String;
+ Win : 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 : String)
+ is
+ begin
+ Explain (Key, Null_Window);
+ end Explain;
+
+ procedure Explain (Key : String;
+ Win : 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 : 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 000000000000..728825e2c9d7
--- /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-2003,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control
+-- $Revision: 1.11 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+-- 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 : String);
+ -- Retrieve the text associated with this key and display it.
+
+ procedure Explain_Context;
+ -- Explain the current context.
+
+ procedure Notepad (Key : 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 000000000000..a3b044dcc3eb
--- /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,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control
+-- $Revision: 1.17 $
+-- $Date: 2009/12/26 17:38:58 $
+-- 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 : 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 : 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 000000000000..57e5bc1a2aca
--- /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-2003,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control
+-- $Revision: 1.10 $
+-- 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 : 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 : 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 000000000000..d871c1cc7796
--- /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,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control
+-- $Revision: 1.14 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Sample.Form_Demo.Aux;
+
+package body Sample.Form_Demo.Handler is
+
+ package Aux renames Sample.Form_Demo.Aux;
+
+ procedure Drive_Me (F : Form;
+ Title : 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 : Form;
+ Lin : Line_Position;
+ Col : Column_Position;
+ Title : 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 000000000000..7d875a0fff6c
--- /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-2003,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control
+-- $Revision: 1.10 $
+-- 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 : Form;
+ Lin : Line_Position;
+ Col : Column_Position;
+ Title : String := "");
+ -- Position the menu at the given point and drive it.
+
+ procedure Drive_Me (F : Form;
+ Title : 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 000000000000..e26a5d98a2be
--- /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 000000000000..bd33f578750d
--- /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 000000000000..0ce3a224c684
--- /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,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control
+-- $Revision: 1.14 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with 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 : String;
+ Reset : 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 : 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 000000000000..77699136e7e6
--- /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-2003,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control
+-- $Revision: 1.10 $
+-- 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 : String;
+ Reset : 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 : 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 000000000000..189118d04021
--- /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-2006,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control
+-- $Revision: 1.17 $
+-- $Date: 2009/12/26 17:38:58 $
+-- 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 : 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 : Integer);
+
+ -- Emit a two digit number and ensure that a leading zero is generated if
+ -- necessary.
+ procedure N_Out (N : 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 : 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 000000000000..aa0a0c29e9f1
--- /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 000000000000..e19464c40801
--- /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-2008,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control
+-- $Revision: 1.13 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with 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 : Window;
+ Title : 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 000000000000..f9bec6a5591e
--- /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-2003,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control
+-- $Revision: 1.10 $
+-- 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 : Window;
+ Title : 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 000000000000..fdac054d2984
--- /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 000000000000..ac5b1399db01
--- /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 000000000000..bb76c4cba78c
--- /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 000000000000..091f08b92a37
--- /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,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control
+-- $Revision: 1.14 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with 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 : 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 : 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 : 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 : 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 000000000000..50eea900cc99
--- /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-2003,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control
+-- $Revision: 1.10 $
+-- 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 : 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 : 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 000000000000..84d29f6351bf
--- /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,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions : --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control
+-- $Revision: 1.16 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with 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 : Menu;
+ Title : 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 : Menu;
+ Lin : Line_Position;
+ Col : Column_Position;
+ Title : 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 000000000000..e9eaa6b74b76
--- /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-2003,2009 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
+-- Version Control
+-- $Revision: 1.10 $
+-- 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 : Menu;
+ Lin : Line_Position;
+ Col : Column_Position;
+ Title : String := "");
+ -- Position the menu at the given point and drive it.
+
+ procedure Drive_Me (M : Menu;
+ Title : 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 000000000000..38646748713f
--- /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 000000000000..b071afc8277d
--- /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 000000000000..e0d6f6732d12
--- /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 000000000000..b8f3653c1d0a
--- /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 000000000000..0b385c45907f
--- /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 000000000000..d3f5a188baf0
--- /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 000000000000..648036f74a0b
--- /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 000000000000..9d0647dad78d
--- /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 000000000000..e6581317f401
--- /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 000000000000..e9e3ee8b3501
--- /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 000000000000..1cc91c15d740
--- /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 000000000000..8888169160a4
--- /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;