aboutsummaryrefslogtreecommitdiff
path: root/Ada95/samples
diff options
context:
space:
mode:
authorXin LI <delphij@FreeBSD.org>2014-02-28 19:12:44 +0000
committerXin LI <delphij@FreeBSD.org>2014-02-28 19:12:44 +0000
commit4b819fa20a8d007a10f2d3e8d6a5dedf7f18fc9a (patch)
treeb8f6e12b479a78216f3bffb8e1258d54087268de /Ada95/samples
parente07762606a5bf651a501cb095c98cba90e4a8fe2 (diff)
downloadsrc-4b819fa20a8d007a10f2d3e8d6a5dedf7f18fc9a.tar.gz
src-4b819fa20a8d007a10f2d3e8d6a5dedf7f18fc9a.zip
Undo two previous imports which was never done in preparation of doing a
new import.
Notes
Notes: svn path=/vendor/ncurses/dist/; revision=262616
Diffstat (limited to 'Ada95/samples')
-rw-r--r--Ada95/samples/Makefile.in155
-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.adb430
-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.adb182
-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.adb195
-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, 0 insertions, 11851 deletions
diff --git a/Ada95/samples/Makefile.in b/Ada95/samples/Makefile.in
deleted file mode 100644
index aa839ffbaf68..000000000000
--- a/Ada95/samples/Makefile.in
+++ /dev/null
@@ -1,155 +0,0 @@
-##############################################################################
-# Copyright (c) 1998-2010,2011 Free Software Foundation, Inc. #
-# #
-# Permission is hereby granted, free of charge, to any person obtaining a #
-# copy of this software and associated documentation files (the "Software"), #
-# to deal in the Software without restriction, including without limitation #
-# the rights to use, copy, modify, merge, publish, distribute, distribute #
-# with modifications, sublicense, and/or sell copies of the Software, and to #
-# permit persons to whom the Software is furnished to do so, subject to the #
-# following conditions: #
-# #
-# The above copyright notice and this permission notice shall be included in #
-# all copies or substantial portions of the Software. #
-# #
-# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR #
-# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, #
-# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL #
-# THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER #
-# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING #
-# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER #
-# DEALINGS IN THE SOFTWARE. #
-# #
-# Except as contained in this notice, the name(s) of the above copyright #
-# holders shall not be 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.46 2011/03/28 23:45:08 tom Exp $
-#
-.SUFFIXES:
-
-SHELL = /bin/sh
-VPATH = @srcdir@
-THIS = Makefile
-
-x = @PROG_EXT@
-
-srcdir = @srcdir@
-prefix = @prefix@
-exec_prefix = @exec_prefix@
-bindir = @bindir@
-datadir = @datadir@
-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@
-################################################################################
-BINDIR = $(DESTDIR)$(bindir)
-DATADIR = $(DESTDIR)$(datadir)
-LIBDIR = $(DESTDIR)$(libdir)
-
-MY_DATADIR = $(DATADIR)/AdaCurses
-
-################################################################################
-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 -L../lib -lAdaCurses @TEST_ARG2@ $(LD_FLAGS) @TEST_LIBS2@
-
-PROGS = tour$x ncurses$x @USE_GNAT_SIGINT@ rain$x
-
-all :: $(PROGS)
- @echo made $@
-
-sources :
- @echo made $@
-
-libs \
-install \
-install.libs ::
- @echo made $@
-
-uninstall \
-uninstall.libs ::
- @echo made $@
-
-install.examples :: $(BINDIR) $(PROGS)
- $(INSTALL) $(PROGS) $(BINDIR)
-
-install.examples :: $(MY_DATADIR)
- $(INSTALL_DATA) explain.txt $(MY_DATADIR)
-
-uninstall.examples ::
- -cd $(BINDIR) && rm -f $(PROGS)
- -rmdir $(BINDIR)
- -rm -f $(MY_DATADIR)/explain.txt
- -rmdir $(MY_DATADIR)
-
-$(BINDIR) \
-$(MY_DATADIR) :
- mkdir -p $@
-
-ncurses$x :
- $(ADAMAKE) $(ADAMAKEFLAGS) ncurses $(CARGS) $(LARGS)
-
-tour$x :
- $(ADAMAKE) $(ADAMAKEFLAGS) tour $(CARGS) $(LARGS)
-
-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] \
- trace screendump b~*.ad[bs]
-
-distclean :: clean
- rm -f Makefile
-
-realclean :: distclean
- @echo made $@
diff --git a/Ada95/samples/README b/Ada95/samples/README
deleted file mode 100644
index c4f16ad306dc..000000000000
--- a/Ada95/samples/README
+++ /dev/null
@@ -1,35 +0,0 @@
--------------------------------------------------------------------------------
--- 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
deleted file mode 100644
index be2cba154ee2..000000000000
--- a/Ada95/samples/explain.txt
+++ /dev/null
@@ -1,186 +0,0 @@
-#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 labeled 'Quit'.
-#INHELP
-You are already in the help system.
-You may leave the help with the Function Key labeled '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 demonstrate 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 labeled "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 does not 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 labeled "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
-labeled "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 would not fit on a typical 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 labeled "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 want 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 want to contribute ?).
-#MOUSEKEYS
-In this demo you may use this keys:
-
- - Key labeled "Help" to get a help
- - Key labeled "Keys" is what you are reading now
- - Key labeled "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
-source code. Feel free to contribute more.
-#TEXTIO
-#TEXTIOKEYS
-#TEXTIO-PAD00
-#END
diff --git a/Ada95/samples/ncurses.adb b/Ada95/samples/ncurses.adb
deleted file mode 100644
index 19f658d5632c..000000000000
--- a/Ada95/samples/ncurses.adb
+++ /dev/null
@@ -1,47 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 00e9afc26078..000000000000
--- a/Ada95/samples/ncurses2-acs_and_scroll.adb
+++ /dev/null
@@ -1,714 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- ncurses --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 2000-2009,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders 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.11 $
--- $Date: 2011/03/23 00:33:00 $
--- 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 arithmetic,
- -- 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.all.last.all.next := fp.all.next;
- fp.all.next.all.last := fp.all.last;
-
- if showit then
- Erase (fp.all.wind);
- Refresh (fp.all.wind);
- end if;
- Delete (fp.all.wind);
-
- if fp = fp.all.next then
- np := null;
- else
- np := fp.all.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.all.wind := getwindow;
- if neww.all.wind = Null_Window then
- exit;
- -- was goto breakout; ha ha ha
- else
-
- if current = null then
- neww.all.next := neww;
- neww.all.last := neww;
- else
- neww.all.next := current.all.next;
- neww.all.last := current;
- neww.all.last.all.next := neww;
- neww.all.next.all.last := neww;
- end if;
- current := neww;
-
- Set_KeyPad_Mode (current.all.wind, True);
- current.all.do_keypad := HaveKeyPad (current.all.wind);
- current.all.do_scroll := HaveScroll (current.all.wind);
- end if;
- end;
- when Character'Pos ('N') mod 16#20# => -- Ctrl('N')
- if current /= null then
- current := current.all.next;
- end if;
- when Character'Pos ('P') mod 16#20# => -- Ctrl('P')
- if current /= null then
- current := current.all.last;
- end if;
- when Character'Pos ('F') mod 16#20# => -- Ctrl('F')
- if current /= null and then HaveScroll (current.all.wind) then
- Scroll (current.all.wind, 1);
- end if;
- when Character'Pos ('B') mod 16#20# => -- Ctrl('B')
- if current /= null and then HaveScroll (current.all.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.all.wind, -1);
- end if;
- when Character'Pos ('K') mod 16#20# => -- Ctrl('K')
- if current /= null then
- current.all.do_keypad := not current.all.do_keypad;
- Set_KeyPad_Mode (current.all.wind, current.all.do_keypad);
- end if;
- when Character'Pos ('S') mod 16#20# => -- Ctrl('S')
- if current /= null then
- current.all.do_scroll := not current.all.do_scroll;
- Allow_Scrolling (current.all.wind, current.all.do_scroll);
- end if;
- when Character'Pos ('W') mod 16#20# => -- Ctrl('W')
- if current /= current.all.next then
- Create (f, Name => dumpfile); -- TODO error checking
- if not Is_Open (f) then
- raise Curses_Exception;
- end if;
- Put_Window (current.all.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.all.next := current.all.next;
- neww.all.last := current;
- neww.all.last.all.next := neww;
- neww.all.next.all.last := neww;
-
- neww.all.wind := Get_Window (f);
- Close (f);
-
- Refresh (neww.all.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.all.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.all.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.all.wind, my, mx);
- if my > tmp.y - ul.y then
- Get_Cursor_Position (current.all.wind, lr.y, lr.x);
- Move_Cursor (current.all.wind, tmp.y - ul.y + 1, 0);
- Clear_To_End_Of_Screen (current.all.wind);
- Move_Cursor (current.all.wind, lr.y, lr.x);
- end if;
- if mx > tmp.x - ul.x then
- for i in 0 .. my - 1 loop
- Move_Cursor (current.all.wind, i, tmp.x - ul.x + 1);
- Clear_To_End_Of_Line (current.all.wind);
- end loop;
- end if;
- Refresh_Without_Update (current.all.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.all.wind, lr.y - ul.y + 0,
- lr.x - ul.x + 0);
- end if;
-
- Get_Window_Position (current.all.wind, ul.y, ul.x);
- Get_Size (current.all.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.all.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.all.wind, -1, 0);
- when Key_Cursor_Down =>
- newwin_move (current.all.wind, 1, 0);
- when Key_Cursor_Left =>
- newwin_move (current.all.wind, 0, -1);
- when Key_Cursor_Right =>
- newwin_move (current.all.wind, 0, 1);
- when Key_Backspace | Key_Delete_Char =>
- declare
- y : Line_Position;
- x : Column_Position;
- tmp : Line_Position;
- begin
- Get_Cursor_Position (current.all.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.all.wind, tmp, x);
- end if;
- x := x - 1;
- Delete_Character (current.all.wind, y, x);
- end if;
- end;
- when others =>
- -- TODO c = '\r' ?
- if current /= null then
- declare
- begin
- Add (current.all.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.all.wind);
- if current /= null then
- usescr := current.all.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
deleted file mode 100644
index 79e4862af0f6..000000000000
--- a/Ada95/samples/ncurses2-acs_and_scroll.ads
+++ /dev/null
@@ -1,41 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index a71c61d5daff..000000000000
--- a/Ada95/samples/ncurses2-acs_display.adb
+++ /dev/null
@@ -1,235 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 4e616c5e1443..000000000000
--- a/Ada95/samples/ncurses2-acs_display.ads
+++ /dev/null
@@ -1,41 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 66271042c0bb..000000000000
--- a/Ada95/samples/ncurses2-attr_test.adb
+++ /dev/null
@@ -1,362 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 51c51435eab5..000000000000
--- a/Ada95/samples/ncurses2-attr_test.ads
+++ /dev/null
@@ -1,42 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 098f98d837b2..000000000000
--- a/Ada95/samples/ncurses2-color_edit.adb
+++ /dev/null
@@ -1,259 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 3e8e392dfe8e..000000000000
--- a/Ada95/samples/ncurses2-color_edit.ads
+++ /dev/null
@@ -1,41 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index c8f6c837ae17..000000000000
--- a/Ada95/samples/ncurses2-color_test.adb
+++ /dev/null
@@ -1,163 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 6e663181a9bc..000000000000
--- a/Ada95/samples/ncurses2-color_test.ads
+++ /dev/null
@@ -1,41 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 1afbb88bf3ff..000000000000
--- a/Ada95/samples/ncurses2-demo_forms.adb
+++ /dev/null
@@ -1,497 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- ncurses --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 2000-2006,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders 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: 2011/03/23 00:44:12 $
--- 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.all (1) := make_label (0, 15, "Sample Form");
- f.all (2) := make_label (2, 0, "Last Name");
- f.all (3) := make_field (3, 0, 1, 18, False);
- f.all (4) := make_label (2, 20, "First Name");
- f.all (5) := make_field (3, 20, 1, 12, False);
- f.all (6) := make_label (2, 34, "Middle Name");
- f.all (7) := make_field (3, 34, 1, 12, False);
- f.all (8) := make_label (5, 0, "Comments");
- f.all (9) := make_field (6, 0, 4, 46, False);
- f.all (10) := make_label (5, 20, "Password:");
- f.all (11) := make_field (5, 30, 1, 9, True);
- secure := f.all (11);
- f.all (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
deleted file mode 100644
index eabaa01b9e91..000000000000
--- a/Ada95/samples/ncurses2-demo_forms.ads
+++ /dev/null
@@ -1,41 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index b1b72aec0b60..000000000000
--- a/Ada95/samples/ncurses2-demo_pad.adb
+++ /dev/null
@@ -1,675 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- ncurses --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 2000-2008,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders 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: 2011/03/23 00:44:12 $
--- 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.all.tv_sec);
- retval.microseconds := Integer (t.all.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
deleted file mode 100644
index b996263c1cde..000000000000
--- a/Ada95/samples/ncurses2-demo_pad.ads
+++ /dev/null
@@ -1,41 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 9693e1a13ba3..000000000000
--- a/Ada95/samples/ncurses2-demo_panels.adb
+++ /dev/null
@@ -1,382 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- ncurses --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 2000-2008,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders 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: 2011/03/23 00:44:12 $
--- 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).all (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
deleted file mode 100644
index eb2878c8501e..000000000000
--- a/Ada95/samples/ncurses2-demo_panels.ads
+++ /dev/null
@@ -1,41 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 9ea98e158c34..000000000000
--- a/Ada95/samples/ncurses2-flushinp_test.adb
+++ /dev/null
@@ -1,135 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 5376c94a54b2..000000000000
--- a/Ada95/samples/ncurses2-flushinp_test.ads
+++ /dev/null
@@ -1,43 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 829d08d23a2f..000000000000
--- a/Ada95/samples/ncurses2-genericputs.adb
+++ /dev/null
@@ -1,117 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index accc3cc63d70..000000000000
--- a/Ada95/samples/ncurses2-genericputs.ads
+++ /dev/null
@@ -1,72 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 21a09f3160f2..000000000000
--- a/Ada95/samples/ncurses2-getch.ads
+++ /dev/null
@@ -1,41 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 2802cfb55017..000000000000
--- a/Ada95/samples/ncurses2-getch_test.adb
+++ /dev/null
@@ -1,254 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 78a0a48c172e..000000000000
--- a/Ada95/samples/ncurses2-getch_test.ads
+++ /dev/null
@@ -1,41 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 29f1fee8281a..000000000000
--- a/Ada95/samples/ncurses2-getopt.adb
+++ /dev/null
@@ -1,163 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- ncurses --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 2000-2008,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders 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: 2011/03/19 12:09:51 $
--- 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.
-
- -- long options 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 collector 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
deleted file mode 100644
index a8b356e968d6..000000000000
--- a/Ada95/samples/ncurses2-getopt.ads
+++ /dev/null
@@ -1,60 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 5b20428c20a1..000000000000
--- a/Ada95/samples/ncurses2-m.adb
+++ /dev/null
@@ -1,448 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index c32d895dc147..000000000000
--- a/Ada95/samples/ncurses2-m.ads
+++ /dev/null
@@ -1,43 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index bce9782372a4..000000000000
--- a/Ada95/samples/ncurses2-menu_test.adb
+++ /dev/null
@@ -1,168 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- ncurses --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 2000-2006,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders 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: 2011/03/23 00:39:28 $
--- 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 Key_Code;
- procedure xAdd (l : Line_Position; c : Column_Position; s : String);
-
- function menu_virtualize (c : Key_Code) return Key_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 : Key_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.all (i) := New_Item (animals (i).all);
- end loop;
- items_a.all (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
deleted file mode 100644
index 17e5b16b3e48..000000000000
--- a/Ada95/samples/ncurses2-menu_test.ads
+++ /dev/null
@@ -1,41 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index ddf8a9a31f64..000000000000
--- a/Ada95/samples/ncurses2-overlap_test.adb
+++ /dev/null
@@ -1,157 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- ncurses --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 2000-2004,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders 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: 2011/03/19 12:07:18 $
--- 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 doupdate");
- 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
deleted file mode 100644
index ce6e3e696121..000000000000
--- a/Ada95/samples/ncurses2-overlap_test.ads
+++ /dev/null
@@ -1,41 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index aa368ba5f9ce..000000000000
--- a/Ada95/samples/ncurses2-slk_test.adb
+++ /dev/null
@@ -1,174 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- ncurses --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 2000-2009,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders 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: 2011/03/19 12:03:08 $
--- 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-through
- -- 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
deleted file mode 100644
index 51e95871a97c..000000000000
--- a/Ada95/samples/ncurses2-slk_test.ads
+++ /dev/null
@@ -1,41 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 97449a40cafc..000000000000
--- a/Ada95/samples/ncurses2-test_sgr_attributes.adb
+++ /dev/null
@@ -1,185 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 241118094e16..000000000000
--- a/Ada95/samples/ncurses2-test_sgr_attributes.ads
+++ /dev/null
@@ -1,41 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 7537afe407ee..000000000000
--- a/Ada95/samples/ncurses2-trace_set.adb
+++ /dev/null
@@ -1,480 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- ncurses2.trace_set --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 2000-2008,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders 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: 2011/03/23 00:40:33 $
--- 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 Key_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 Key_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.all (n) := New_Item (t_tbl (n).name.all);
- end loop;
- items_a.all (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
deleted file mode 100644
index 7bbf8ca5450a..000000000000
--- a/Ada95/samples/ncurses2-trace_set.ads
+++ /dev/null
@@ -1,41 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 8ae327242ba4..000000000000
--- a/Ada95/samples/ncurses2-util.adb
+++ /dev/null
@@ -1,190 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index f46749f06862..000000000000
--- a/Ada95/samples/ncurses2-util.ads
+++ /dev/null
@@ -1,76 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 2fe01970899d..000000000000
--- a/Ada95/samples/ncurses2.ads
+++ /dev/null
@@ -1,44 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index d673018eb036..000000000000
--- a/Ada95/samples/rain.adb
+++ /dev/null
@@ -1,179 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 3ad1912c5e49..000000000000
--- a/Ada95/samples/rain.ads
+++ /dev/null
@@ -1,43 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index c49f37d60246..000000000000
--- a/Ada95/samples/sample-curses_demo-attributes.adb
+++ /dev/null
@@ -1,122 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 6d9b4e8df80f..000000000000
--- a/Ada95/samples/sample-curses_demo-attributes.ads
+++ /dev/null
@@ -1,45 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 490685c75076..000000000000
--- a/Ada95/samples/sample-curses_demo-mouse.adb
+++ /dev/null
@@ -1,220 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index ad78d0d0a750..000000000000
--- a/Ada95/samples/sample-curses_demo-mouse.ads
+++ /dev/null
@@ -1,45 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 4dd96a721d2a..000000000000
--- a/Ada95/samples/sample-curses_demo.adb
+++ /dev/null
@@ -1,143 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- Sample.Curses_Demo --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 1998-2004,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders shall not be 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: 2011/03/23 00:29:04 $
--- 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 mechanism.
-
- 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.all (2), O);
- O.Selectable := False;
- Set_Options (Itm.all (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
deleted file mode 100644
index ed4ad0f019f8..000000000000
--- a/Ada95/samples/sample-curses_demo.ads
+++ /dev/null
@@ -1,45 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 5587099b242a..000000000000
--- a/Ada95/samples/sample-explanation.adb
+++ /dev/null
@@ -1,430 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- Sample.Explanation --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders shall not be used in advertising or otherwise to promote the --
--- sale, use or other dealings in this Software without prior written --
--- authorization. --
-------------------------------------------------------------------------------
--- Author: Juergen Pfeifer, 1996
--- Version Control
--- $Revision: 1.26 $
--- $Date: 2011/03/26 22:33:29 $
--- 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.txt";
- 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);
-
- function Check_File (Name : String) return Boolean;
-
- 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 labeled '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.all.Line.all);
- exit when H.all.Next = null;
- H := H.all.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.all.Line.all);
- L := L + 1;
- exit when C.all.Next = null or else L = Height;
- C := C.all.Next;
- end loop;
- if C.all.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.all.Next /= null then
- Move_Cursor (W, Height - 1, 0);
- Scroll (W, 1);
- Current := Current.all.Next;
- Top_Line := Top_Line.all.Next;
- Add (W, Current.all.Line.all);
- end if;
- when Key_Cursor_Up =>
- if Top_Line.all.Prev /= null then
- Move_Cursor (W, 0, 0);
- Scroll (W, -1);
- Top_Line := Top_Line.all.Prev;
- Current := Current.all.Prev;
- Add (W, Top_Line.all.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.all.Next := Current;
- Current.all.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.all.Next;
- Release_String (Root.all.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.all.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.all.Line.all, Integer (Columns - 2));
- L := L + 1;
- T := T.all.Next;
- exit when T = null;
- end loop;
- T := H;
- Release_Help (T);
- Refresh_Without_Update (W);
- Notepad_To_Context (P);
- end if;
- end Notepad;
-
- function Check_File (Name : String) return Boolean is
- The_File : File_Type;
- begin
- Open (The_File, In_File, Name);
- Close (The_File);
- return True;
- exception
- when Name_Error =>
- return False;
- end Check_File;
-
-begin
- if Check_File ("/usr/share/AdaCurses/" & File_Name) then
- Open (F, In_File, "/usr/share/AdaCurses/" & File_Name);
- elsif Check_File (File_Name) then
- Open (F, In_File, File_Name);
- else
- Put_Line (Standard_Error,
- "The file explain.txt was not found in the current directory."
- );
- raise Name_Error;
- end if;
-end Sample.Explanation;
diff --git a/Ada95/samples/sample-explanation.ads b/Ada95/samples/sample-explanation.ads
deleted file mode 100644
index 728825e2c9d7..000000000000
--- a/Ada95/samples/sample-explanation.ads
+++ /dev/null
@@ -1,59 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index a3b044dcc3eb..000000000000
--- a/Ada95/samples/sample-form_demo-aux.adb
+++ /dev/null
@@ -1,263 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 7e7f7cd21e39..000000000000
--- a/Ada95/samples/sample-form_demo-aux.ads
+++ /dev/null
@@ -1,92 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- Sample.Form_Demo.Aux --
--- --
--- S P E C --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders shall not be 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;
-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 being 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
deleted file mode 100644
index d871c1cc7796..000000000000
--- a/Ada95/samples/sample-form_demo-handler.adb
+++ /dev/null
@@ -1,98 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 7d875a0fff6c..000000000000
--- a/Ada95/samples/sample-form_demo-handler.ads
+++ /dev/null
@@ -1,64 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index ed84526feae2..000000000000
--- a/Ada95/samples/sample-form_demo.adb
+++ /dev/null
@@ -1,130 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- Sample.Form_Demo --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 1998-2006,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders shall not be 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: 2011/03/23 00:44:12 $
--- 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.all (6), Enum_Field);
- Set_Field_Type (FA.all (7), I_F);
- Set_Field_Type (FA.all (8), Mft);
-
- F1 := new User_Data'(Data => 4711);
- Fld_U.Set_User_Data (FA.all (1), F1);
-
- Fh.Drive_Me (Frm);
-
- Fld_U.Get_User_Data (FA.all (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
deleted file mode 100644
index bd33f578750d..000000000000
--- a/Ada95/samples/sample-form_demo.ads
+++ /dev/null
@@ -1,45 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 4ff70be7bb8a..000000000000
--- a/Ada95/samples/sample-function_key_setting.adb
+++ /dev/null
@@ -1,214 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- Sample.Function_Key_Setting --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders shall not be 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: 2011/03/23 00:44:12 $
--- 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.all.Labels (I));
- if Reset then
- Set_Soft_Label_Key (I, " ");
- end if;
- end loop;
- P.all.Prev := Top_Of_Stack;
- -- now store active help context and notepad
- P.all.Help := Active_Context;
- P.all.Notepad := Active_Notepad;
- -- The notepad must now vanish and the new notepad is empty.
- if P.all.Notepad /= Null_Panel then
- Hide (P.all.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.all.Labels (I), Justification);
- end loop;
- pragma Assert (Active_Context /= null);
- Release_String (Active_Context);
- Active_Context := P.all.Help;
- Refresh_Soft_Label_Keys_Without_Update;
- Notepad_To_Context (P.all.Notepad);
- Top_Of_Stack := P.all.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.all.Help.all = Key then
- return True;
- else
- P := P.all.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
deleted file mode 100644
index 4188158f05c9..000000000000
--- a/Ada95/samples/sample-function_key_setting.ads
+++ /dev/null
@@ -1,82 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- Sample.Function_Key_Setting --
--- --
--- S P E C --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders shall not be 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;
-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 identifier
-
- 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
deleted file mode 100644
index ad60caf4b0cb..000000000000
--- a/Ada95/samples/sample-header_handler.adb
+++ /dev/null
@@ -1,182 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- Sample.Header_Handler --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders shall not be used in advertising or otherwise to promote the --
--- sale, use or other dealings in this Software without prior written --
--- authorization. --
-------------------------------------------------------------------------------
--- Author: Juergen Pfeifer, 1996
--- Version Control
--- $Revision: 1.19 $
--- $Date: 2011/03/22 23:54:38 $
--- Binding Version 01.00
-------------------------------------------------------------------------------
-with Ada.Calendar; use Ada.Calendar;
-with Terminal_Interface.Curses.Text_IO.Integer_IO;
-with Sample.Manifest; use Sample.Manifest;
-
-pragma Elaborate_All (Terminal_Interface.Curses.Text_Io.Integer_IO);
-
--- 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 is not 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
deleted file mode 100644
index aa0a0c29e9f1..000000000000
--- a/Ada95/samples/sample-header_handler.ads
+++ /dev/null
@@ -1,53 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index ceef268134a5..000000000000
--- a/Ada95/samples/sample-helpers.adb
+++ /dev/null
@@ -1,68 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- Sample.Helpers --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders shall not be 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: 2011/03/19 12:13:21 $
--- Binding Version 01.00
-------------------------------------------------------------------------------
-with Sample.Explanation; use Sample.Explanation;
-
--- This package contains some convenient 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
deleted file mode 100644
index 28e89bb5707c..000000000000
--- a/Ada95/samples/sample-helpers.ads
+++ /dev/null
@@ -1,54 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- Sample.Helpers --
--- --
--- S P E C --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders shall not be 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;
-
--- This package contains some convenient 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
deleted file mode 100644
index 1d3f20c74b4f..000000000000
--- a/Ada95/samples/sample-keyboard_handler.adb
+++ /dev/null
@@ -1,194 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- Sample.Keyboard_Handler --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 1998-2006,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders shall not be 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: 2011/03/23 00:34:24 $
--- 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.all (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.all (2), Enum_Field);
- Set_Background (FA.all (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 occurred
- 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
deleted file mode 100644
index ac5b1399db01..000000000000
--- a/Ada95/samples/sample-keyboard_handler.ads
+++ /dev/null
@@ -1,55 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index bb76c4cba78c..000000000000
--- a/Ada95/samples/sample-manifest.ads
+++ /dev/null
@@ -1,67 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 091f08b92a37..000000000000
--- a/Ada95/samples/sample-menu_demo-aux.adb
+++ /dev/null
@@ -1,204 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index e82aedf995b0..000000000000
--- a/Ada95/samples/sample-menu_demo-aux.ads
+++ /dev/null
@@ -1,71 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- Sample.Menu_Demo.Aux --
--- --
--- S P E C --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders shall not be 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;
-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 being 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
deleted file mode 100644
index 84d29f6351bf..000000000000
--- a/Ada95/samples/sample-menu_demo-handler.adb
+++ /dev/null
@@ -1,108 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index e9eaa6b74b76..000000000000
--- a/Ada95/samples/sample-menu_demo-handler.ads
+++ /dev/null
@@ -1,64 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 80cd94b1d4e5..000000000000
--- a/Ada95/samples/sample-menu_demo.adb
+++ /dev/null
@@ -1,396 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- Sample.Menu_Demo --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 1998-2008,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders shall not be used in advertising or otherwise to promote the --
--- sale, use or other dealings in this Software without prior written --
--- authorization. --
-------------------------------------------------------------------------------
--- Author: Juergen Pfeifer, 1996
--- Version Control
--- $Revision: 1.19 $
--- $Date: 2011/03/23 00:44:12 $
--- 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.all (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.all (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.all (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.all (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
deleted file mode 100644
index b071afc8277d..000000000000
--- a/Ada95/samples/sample-menu_demo.ads
+++ /dev/null
@@ -1,45 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index e0d6f6732d12..000000000000
--- a/Ada95/samples/sample-my_field_type.adb
+++ /dev/null
@@ -1,68 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index b8f3653c1d0a..000000000000
--- a/Ada95/samples/sample-my_field_type.ads
+++ /dev/null
@@ -1,61 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index a458a37cdbd9..000000000000
--- a/Ada95/samples/sample-text_io_demo.adb
+++ /dev/null
@@ -1,195 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- Sample.Text_IO_Demo --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 1998-2006,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders shall not be 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: 2011/03/23 00:44:12 $
--- 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;
-
-pragma Elaborate_All (Terminal_Interface.Curses.Text_Io.Complex_IO);
-pragma Elaborate_All (Terminal_Interface.Curses.Text_Io.Decimal_IO);
-pragma Elaborate_All (Terminal_Interface.Curses.Text_Io.Enumeration_IO);
-pragma Elaborate_All (Terminal_Interface.Curses.Text_Io.Fixed_IO);
-pragma Elaborate_All (Terminal_Interface.Curses.Text_Io.Float_IO);
-pragma Elaborate_All (Terminal_Interface.Curses.Text_Io.Integer_IO);
-pragma Elaborate_All (Terminal_Interface.Curses.Text_Io.Modular_IO);
-
-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
deleted file mode 100644
index d3f5a188baf0..000000000000
--- a/Ada95/samples/sample-text_io_demo.ads
+++ /dev/null
@@ -1,45 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 9b3759f0c53a..000000000000
--- a/Ada95/samples/sample.adb
+++ /dev/null
@@ -1,220 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- Sample --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 1998-2008,2011 Free Software Foundation, Inc. --
--- --
--- Permission is hereby granted, free of charge, to any person obtaining a --
--- copy of this software and associated documentation files (the --
--- "Software"), to deal in the Software without restriction, including --
--- without limitation the rights to use, copy, modify, merge, publish, --
--- distribute, distribute with modifications, sublicense, and/or sell --
--- copies of the Software, and to permit persons to whom the Software is --
--- furnished to do so, subject to the following conditions: --
--- --
--- The above copyright notice and this permission notice shall be included --
--- in all copies or substantial portions of the Software. --
--- --
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
--- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
--- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
--- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
--- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
--- --
--- Except as contained in this notice, the name(s) of the above copyright --
--- holders shall not be 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: 2011/03/23 00:44:12 $
--- 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.all (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.all (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
deleted file mode 100644
index 9d0647dad78d..000000000000
--- a/Ada95/samples/sample.ads
+++ /dev/null
@@ -1,43 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index e6581317f401..000000000000
--- a/Ada95/samples/status.adb
+++ /dev/null
@@ -1,57 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index e9e3ee8b3501..000000000000
--- a/Ada95/samples/status.ads
+++ /dev/null
@@ -1,60 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 1cc91c15d740..000000000000
--- a/Ada95/samples/tour.adb
+++ /dev/null
@@ -1,46 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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
deleted file mode 100644
index 8888169160a4..000000000000
--- a/Ada95/samples/tour.ads
+++ /dev/null
@@ -1,41 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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;