d/freebsd-skq
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Import a stock copy of ncurses 5.8 into the vendor space.

Browse Source 
It seems both local changes we made to 5.7 have already been fixed
upstream properly, so there is no need to preserve the changes. Also,
with SVN we import full source trees. Unlike CVS, where we removed
unneeded cruft.
This commit is contained in:
ed 2011-04-30 10:55:14 +00:00
parent 4401a3c978
commit 96a5d985d4
1008 changed files with 187842 additions and 12493 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

590
ANNOUNCE
View File

@ -1,4 +1,4 @@
Announcing ncurses 5.7
Announcing ncurses 5.8
The ncurses (new curses) library is a free software emulation of
curses in System V Release 4.0, and more. It uses terminfo format,
@ -27,217 +27,393 @@
Release Notes
This release is designed to be upward compatible from ncurses 5.0
through 5.6; very few applications will require recompilation,
through 5.7; very few applications will require recompilation,
depending on the platform. These are the highlights from the
change-log since ncurses 5.6 release.
change-log since ncurses 5.7 release.
Interface changes:
* generate linkable stubs for some macros:
getattrs
Interface changes
New features and improvements:
* library
+ new flavor of the ncurses library provides rudimentary
support for POSIX threads. Several functions are reentrant,
but most require either a window-level or screen-level mutex.
(This is API-compatible, but not ABI-compatible with the
normal library).
+ add NCURSES_OPAQUE symbol to curses.h, will use to make
structs opaque in selected configurations.
+ add NCURSES_EXT_FUNCS and NCURSES_EXT_COLORS symbols to
curses.h to make it simpler to tell if the extended functions
and/or colors are declared.
+ add wresize() to C++ binding
+ eliminate fixed-buffer vsprintf() calls in C++ binding.
+ add several functions to C++ binding which wrap C functions
that pass a WINDOW* parameter.
+ adapt mouse-handling code from menu library in form-library
+ improve tracing for form library, showing created forms,
fields, etc.
+ make $NCURSES_NO_PADDING feature work for termcap interface .
+ add check to trace-file open, if the given name is a
directory, add ".log" to the name and try again.
+ several new manpages: curs_legacy.3x, curs_memleaks.3x,
curs_opaque.3x and curs_threads.3x
* programs:
+ modified three test-programs to demonstrate the threading
support in this version: ditto, rain, worm.
+ several new test-programs: demo_panels, dots_mvcur,
inch_wide, inchs, key_name, key_names, savescreen,
savescreen.sh test_arrays, test_get_wstr, test_getstr,
test_instr, test_inwstr and test_opaque.
+ add adacurses-config to the Ada95 install.
+ modify tic -f option to format spaces as \s to prevent them
from being lost when that is read back in unformatted
strings.
+ The tack program is now distributed separately from ncurses.
* terminal database
+ added entries:
o Eterm-256color, Eterm-88color and rxvt-88color
o aterm
o konsole-256color
o mrxvt
o screen.mlterm
o screen.rxvt
o teraterm4.59 is now the primary primary teraterm entry,
renamed original to teraterm2.3
o 9term terminal
o Newbury Data entries
+ updated/improved entries:
o gnome to version 2.22.3
o h19, z100
o konsole to version 1.6.6
o mlterm, mlterm+pcfkeys
o xterm, and building-blocks for function-keys to [3]xterm
patch #230.
* turn on _XOPEN_CURSES definition in curses.h.
* change _nc_has_mouse to has_mouse, reflect its use in C++ and
Ada95.
* add is_pad and is_subwin functions for opaque access to the WINDOW
structure.
* add tiparm, based on review of X/Open Curses Issue 7.
Major bug fixes:
* add logic to tic for cancelling strings in user-defined
capabilities (this is needed for current konsole terminfo entry).
* modify mk-1st.awk so the generated makefile rules for linking or
installing shared libraries do not first remove the library, in
case it is in use, e.g., libncurses.so by /bin/sh.
* correct check for notimeout() in wgetch().
* fix a sign-extension bug in infocmp's repair_acsc() function.
* change winnstr() to stop at the end of the line.
* make Ada95 demo_panels() example work.
* fix for adding a non-spacing character at the beginning of a line.
* fill in extended-color pair to make colors work for
wide-characters using extended-colors.
* improve refresh of window on top of multi-column characters,
taking into account split characters on left/right window
boundaries.
* modify win_wchnstr() to ensure that only a base cell is returned
for each multi-column character.
* improve waddch() and winsch() handling of EILSEQ from mbrtowc() by
using unctrl() to display illegal bytes rather than trying to
append further bytes to make up a valid sequence.
* restore curs_set() state after endwin()/refresh()
* modify keyname() to use "^X" form only if meta() has been called,
or if keyname() is called without initializing curses, e.g., via
initscr() or newterm().
* modify unctrl() to check codes in 128-255 range versus isprint().
If they are not printable, and locale was set, use a "M-" or "~"
sequence.
* improve resizeterm() by moving ripped-off lines, and repainting
the soft-keys.
* modify form library to accept control characters such as newline
in set_field_buffer(), which is compatible with Solaris.
* use NCURSES_MOUSE_MASK() in definition of BUTTON_RELEASE(), etc.,
to make those work properly with the --enable-ext-mouse
configuration
* correct some functions in Ada95 binding which were using return
value from C where none was returned.
* reviewed/fixed issues reported by Coverity and Klocwork tools.
New features and improvements
Library Improvements
* add a terminal driver for Windows console, which supports a MinGW
port to Windows.
* add extended functions which specify the SCREEN pointer for
several curses functions which use the global SP.
* improve the NCURSES_NO_UTF8_ACS feature by adding a check for an
extended terminfo capability U8.
* improve performance of tigetstr, etc., by using hashing code from
tic.
* add WACS_xxx definitions to wide-character configuration for
thick- and double-lines.
* modify init_pair to allow caller to create extra color pairs
beyond the color_pairs limit, which use default colors.
Improvements to Programs
* add tabs program.
* modify tic's -I/-C dump to reformat acsc strings into canonical
form (sorted, unique mapping).
* add checks in tic for inconsistent cursor-movement controls, and
for inconsistent printer-controls.
* add special case to _nc_infotocap (used by tic and infocmp) to
recognize the setaf/setab strings from xterm+256color and
xterm+88color, and provide a reduced version which works with
termcap.
Terminal Database
* added entries:
+ bterm terminfo entry, based on bogl 0.1.18
+ cons25-debian entry
+ eterm-color entry
+ linux-16color
+ mlterm+256color entry, for mlterm 3.0.0
+ several screen-bce.xxx entries
+ screen.Eterm terminfo entry
+ vwmterm entry
+ xterm-utf8 entry as a demo of the U8 feature
* updated/improved entries:
+ use extended capabilities:
o add U8 feature to denote entries for terminal emulators
which do not support VT100 SI/SO when processing UTF-8
encoding
o add XT capability to entries for terminals that support
both xterm-style mouse- and title-controls, for screen
which special-cases TERM beginning with xterm or rxvt
+ improvements based on new checks in tic:
+
o fill in no-parameter forms of cursor-movement where a
parameterized form is available
o fill in missing cursor controls where the form of the
controls is ANSI
o add parameterized cursor-controls to linux-basic
o modify nsterm, xnuppc and tek4115 to make sgr/sgr0
consistent
o change several terminfo entries to make consistent use
of ANSI clear-all-tabs
+ extend ansi.sys pfkey capability from kf1-kf10 to kf1-kf48,
moving function key definitions from emx-base for
consistency.
+ correct missing final 'p' in pfkey capability of
ansi.sys-old.
+ rename atari and st52 terminfo entries to atari-old,
st52-old, use newer entries from FreeMiNT.
+ repurpose gnome terminfo entries as vte, retaining gnome
variants for compatibility, but generally deprecating those
since the VTE library is what actually defines the behavior
of "gnome", etc., since 2003.
+ improve interix smso terminfo capability by using reverse
rather than bold.
+ correct initc capability of linux-c-nc end-of-range, make
similar change for dg+ccc and dgunix+ccc.
+ update minix terminfo entry.
+ updated nsterm* entries.
+ remove unnecessary kcan assignment to ^C from putty.
+ suppress ncv in screen and konsole-base entries, allowing
underline.
+ change ncv and op capabilities in sun-color terminfo entry to
match Sun's entry for this.
+ fix typo in rmso for tek4106 entry.
+ improve acsc string for vt52, show arrow keys.
+ add hard-reset for rs2 to wsvt25 to help ensure that reset
ends the alternate character set.
+ add ccc and initc capabilities to xterm-16color.
Major bug fixes
* ncurses library
+ wide character support
o modify length returned by getcchar to count the trailing
null which is documented in X/Open.
o fix an infinite recursion when adding a legacy-coding
8-bit value using insch.
o improve a workaround in adding wide-characters, when a
control character is found. The library uses unctrl to
obtain a printable version of the control character, but
was not passing color or video attributes.
o modify waddch_literal, updating line-pointer after a
multicolumn character is found to not fit on the current
row, and wrapping is done. Since the line-pointer was
not updated, the wrapped multicolumn character was
written to the beginning of the current row.
o fixes in wins_nwstr and related functions to ensure that
special characters, i.e., control characters are handled
properly with the wide-character configuration.
o correct internal _nc_insert_ch to use _nc_insert_wch
when inserting wide characters, since the wins_wch
function that it used did not update the cursor
position.
+ mouse
o add check if Gpm_Open returns a -2, e.g., for "xterm".
This is normally suppressed but can be overridden using
$NCURSES_GPM_TERMS. Ensure that Gpm_Close is called in
this case.
o add check in mouse-driver to disable connection if GPM
returns a zero, indicating that the connection is
closed.
o modify getmouse to act as its documentation implied,
returning on each call the preceding event until none
are left. When no more events remain, it will return
ERR.
+ miscellaneous
o improve handling of color-pairs embedded in attributes
for the extended-colors configuration.
o add check for failure to open hashed-database needed for
db4.6.
o modify use of $CC environment variable which is defined
by X/Open as a curses feature, to ignore it if it is not
a single character.
o modify declaration of cur_term when broken-linker is
used, but enable-reentrant is not, to match pre-5.7.
o correct limit-checks in derwin.
o remove old check in mvderwin which prevented moving a
derived window whose origin happened to coincide with
its parent's origin.
o correct limit-checks in newwin, to ensure that windows
have nonzero size.
o modify set_curterm to make broken-linker configuration
work with changes from 20090228.
o modify wgetch to ensure it checks SIGWINCH when it gets
an error in non-blocking mode.
o correct limit-check in wredrawln, accounting for
begy/begx values.
o fix a null-pointer check in _nc_format_slks in
lib_slk.c, from 20070704 changes.
o correct translation of "^" in _nc_infotocap, used to
transform terminfo to termcap strings.
o modify _nc_wgetch to check for a -1 in the fifo, e.g.,
after a SIGWINCH, and discard that value, to avoid
confusing application.
* other libraries
+ correct transfer of multicolumn characters in multirow
field_buffer, which stopped at the end of the first row due
to filling of unused entries in a cchar_t array with nulls.
+ correct buffer-size after internal resizing of wide-character
set_field_buffer, broken in 20081018 changes.
+ correct layout of working window used to extract data in
wide-character configured by set_field_buffer
Portability
Portability:
* configure script:
+ new options:
--disable-big-strings
control whether static string tables are generated
as single large strings (to improve startup
performance), or as array of individual strings.
--disable-libtool-version
use the "-version-number" feature which was added
in libtool 1.5. The default value for the option
uses the newer feature, which makes libraries
generated using libtool compatible with the
standard builds of ncurses.
--disable-relink
control whether shared libraries are relinked
(during install) when rpath is enabled.
--disable-rpath-hack
disable a feature which adds rpath options for
libraries in unusual places.
--disable-tic-depends
make explicit whether tic library depends on
ncurses/ncursesw library.
--enable-interop
integrate changes for generic/interop support to
form-library.
--enable-mixed-case
override the configure script's check if the
filesystem supports mixed-case filenames. This
allows one to control how the terminal database
maps to the filesystem. For filesystems that do not
support mixed-case, the library uses generate
2-character (hexadecimal) codes for the lower-level
of the filesystem terminfo database
--enable-pc-files
generate ".pc" files for each of the libraries, and
install them in pkg-config's library directory.
--enable-reentrant
builds a different flavor of the ncurses library
(ncursest) which improves reentrant use of the
library by reducing global and static variables
(see the "--with-pthread" option for the threaded
support).
--enable-pthreads-eintr
control whether to allow EINTR to interrupt a read
operation in wgetch. This applies only to the
pthread configuration
--enable-weak-symbols
use weak-symbols for linking to the POSIX thread
library, and use the same soname for the ncurses
shared library as the normal library (caveat: the
ABI is for the threaded library, which makes global
data accessed via functions).
--enable-sp-funcs
compile-in support for extended functions which
accept a SCREEN pointer, reducing the need for
juggling the global SP value with set_term and
delscreen.
--with-pthread
build with the POSIX thread library (tested with
AIX, Linux, FreeBSD, OpenBSD, HPUX, IRIX64,
Solaris, Tru64).
--enable-term-driver
compile with terminal-driver. That is used in the
MinGW port, and (being somewhat more complicated)
is an experimental alternative to the conventional
termlib internals. Currently, it requires the
sp-funcs feature to be enabled.
--with-ticlib
build/install the tic-support functions in a
separate library
--with-ncurses-wrap-prefix
allows setting the prefix for functions used to
wrap global variables to something other than
"_nc_".
--with-pkg-config=[DIR]
check for pkg-config, optionally specifying its
path.
--without-manpages
tells the configure script to suppress the install
of ncurses' manpages.
--without-tests
suppress building test programs.
+ improved options:
--enable-ext-colors
requires the wide-character configuration.
--with-chtype
ignore option value "unsigned" is always added to
the type in curses.h; do the same for
--with-mmask-t.
--with-dmalloc
build-fix for redefinition of strndup.
--with-hashed-db
accepts a parameter which is the install-prefix of
a given Berkeley Database.
--with-hashed-db
the $LIBS environment variable overrides the search
for the db library.
--without-hashed-db
assumed when "--disable-database" is used.
o correct logic for --with-database, which was coded as an
enable-type switch.
o omit the opaque-functions from lib_gen.o when
--disable-ext-funcs is used.
* packaging:
+ *-config scripts:
o modify adacurses-config to look for ".ali" files in the
adalib directory.
o correct install for the Ada95 tree, which omitted
libAdaCurses.a used in adacurses-config.
o change install for adacurses-config to provide
additional flavors such as adacursesw-config, for
ncursesw.
o modify scripts to generate ncurses*-config and pc-files
to add dependency for tinfo library.
o use ncurses*-config scripts if available for
test/configure.
o correct name for termlib in ncurses*-config, e.g., if it
is renamed to provide a single file for ncurses/ncursesw
libraries.
o generate manpages for the *-config scripts, adapted from
help2man.
o modify install-rule for manpages so that *-config
manpages will install when building with --srcdir.
o build-fixes for OpenSolaris aka Solaris 11, for
wide-character configuration as well as for rpath
feature in *-config scripts.
o use $includedir symbol in misc/ncurses-config.in, add
--includedir option.
o improve install-rules for pc-files.
o create the pkg-config library directory if needed.
o fix typo "==" where "=" is needed in ncurses-config.in
and gen-pkgconfig.in files.
o modify gen-pkgconfig.in to eliminate a dependency on
rpath when deciding whether to add $LIBS to --libs
output; that should be shown for the ncurses and tinfo
libraries without taking rpath into account.
o modify handling of $PKG_CONFIG_LIBDIR to use only the
first item in a possibly colon-separated list.
+ other packaging issues
o add make-tar.sh scripts to Ada95 and test subdirectories
to help with making those separately distributable.
o add Ada95/configure script, to use in tar-file created
by Ada95/make-tar.sh.
o remove tar-copy.sh and related configure/Makefile
chunks, since the Ada95 binding is now installed using
rules in Ada95/src.
* cross-compiling:
+ improve configure checks for location of tic and infocmp
programs used for installing database and for generating
fallback data, e.g., for cross-compiling.
+ modify #define's for build-compiler to suppress cchar_t
symbol from compile of make_hash and make_keys, improving
cross-compilation of ncursesw.
+ simplify include-dependencies of make_hash and make_keys, to
reduce the need for setting BUILD_CPPFLAGS in cross-compiling
when the build- and target-machines differ.
+ correct cross-compiling configure check for CF_MKSTEMP macro,
by adding a check cache variable set by AC_CHECK_FUNC.
* library dependencies:
+ revise wadd_wch and wecho_wchar to eliminate dependency on
unctrl.
+ adjust configure script so that "t" is not added to library
suffix when weak-symbols are used, allowing the pthread
configuration to more closely match the non-thread naming.
* building the Ada95 tree:
+ changes to use gnatmake project files in the Ada95 tree.
+ add/use configure check to turn on project rules for
Ada95/src.
+ old gnatmake (3.15) does not produce libraries using
project-file; work around by adding script to generate
alternate makefile.
+ add configure --with-ada-sharedlib option, for the test_make
rule.
+ move Ada95-related logic into aclocal.m4, since additional
checks will be needed to distinguish old/new implementations
of gnat.
+ add test_make / test_clean / test_install rules in Ada95/src
+ change install-path for adainclude directory to
/usr/share/ada (was /usr/lib/ada).
* other configure/build issues:
+ build-fixes for LynxOS
+ modify shared-library rules to allow FreeBSD 3.x to use
rpath.
+ build-fix for FreeBSD "contemporary" TTY interface.
+ build-fixes for AIX with libtool.
+ build-fixes for Darwin and libtool.
+ modify BeOS-specific ifdef's to build on Haiku.
+ corrected gcc options for building shared libraries on
Solaris and IRIX64.
+ change shared-library configuration for OpenBSD, make rpath
work.
+ build-fixes for using libutf8, e.g., on OpenBSD 3.7
+ add "-e" option in ncurses/Makefile.in when generating
source-files to force earlier exit if the build environment
fails unexpectedly.
+ add support for shared libraries for QNX.
+ change delimiter in MKlib_gen.sh from '%' to '@', to avoid
substitution by IBM xlc to '#' as part of its extensions to
digraphs.
* library:
+ rewrite wrapper for wcrtomb(), making it work on Solaris.
This is used in the form library to determine the length of
the buffer needed by field_buffer.
+ add/use configure script macro CF_SIG_ATOMIC_T, use the
corresponding type for data manipulated by signal handlers.
+ set locale in misc/ncurses-config.in since it uses a range
+ disable GPM mouse support when $TERM does not happen to
contain "linux", since Gpm_Open() no longer limits its
assertion to terminals that it might handle, e.g., within
"screen" in xterm.
+ reset mouse file-descriptor when unloading GPM library.
+ make CCHARW_MAX value configurable, noting that changing this
would change the size of cchar_t, and would be
ABI-incompatible.
+ improve comparison of program-names when checking for linked
flavors such as "reset" by ignoring the executable suffix.
+ drop mkdirs.sh, use "mkdir -p".
+ drop misc/ncu-indent and misc/jpf-indent; they are provided
by an external package [3]cindent.
+ change makefiles to use $ARFLAGS rather than $AR_OPTS,
provide a configure check to detect whether a "-" is needed
before "ar" options.
+ modify CF_DISABLE_LEAKS configure macro so that the
--enable-leaks option is not the same as --disable-leaks.
+ improve configure script macros CF_HEADER_PATH and
CF_LIBRARY_PATH by adding CFLAGS, CPPFLAGS and LDFLAGS, LIBS
values to the search-lists.
+ improve configure macros CF_GCC_VERSION and CF_GCC_WARNINGS
to work with gcc 4.x's c89 alias, which gives warning
messages for cases where older versions would produce an
error.
+ modify CF_WITH_LIBTOOL configure check to allow unreleased
libtool version numbers (e.g. which include alphabetic chars,
as well as digits, after the final '.').
+ improve use of symbolic links in makefiles by using "-f"
option if it is supported, to eliminate temporary removal of
the target
+ add a configure-time check to pick a suitable value for
CC_SHARED_OPTS for Solaris.
+ add -shared option to MK_SHARED_LIB when -Bsharable is used,
for *BSD's, without which "main" might be one of the shared
library's dependencies.
+ modify configure script to allow building shared libraries
with gcc on AIX 5 or 6.
+ suppress configure check for static/dynamic linker flags for
gcc on Solaris 10, since gcc is confused by absence of static
libc, and does not switch back to dynamic mode before
finishing the libraries.
+ suppress configure check for static/dynamic linker flags for
gcc on Darwin.
+ modify misc/run_tic.in to create parent directory, in case
this is a new install of hashed database.
+ modify configure check for tic program, used for fallbacks,
to a warning if not found. This makes it simpler to use
additonal scripts to bootstrap the fallbacks code using tic
from the build tree.
* test programs:
+ update test programs to build/work with various UNIX curses
for comparisons.
+ add test/demo_terminfo, for comparison with demo_termcap.
+ improve test/ncurses.c 'F' test, show combining characters in
color.
+ fix logic for 'V' in test/ncurses.c tests f/F.
+ improve test/ncurses.c 'a test to put mouse droppings in the
proper window.
+ modify ncurses 'F' test to demo wborder_set with colored
lines.
+ modify ncurses 'f' test to demo wborder with colored lines.
+ improve test/ncurses.c 'a' test, using unctrl more
consistently to display meta-characters.
+ correct use of key_name in test/ncurses.c 'A' test, which
only displays wide-characters, not key-codes since 20070612.
+ add test/clip_printw.c to illustrate how to use printw
without wrapping.
+ modify test-programs, e.g,. test/view.c, to address subtle
differences between Tru64/Solaris and HPUX/AIX getcchar
return values.
+ add some test programs (and make these use the same special
keys by sharing linedata.h functions): test/test_addstr.c
test/test_addwstr.c test/test_addchstr.c
test/test_add_wchstr.c
+ add test/xterm-256color.dat
+ modify test programs to allow them to be built with NetBSD
curses.
+ fixes for test programs to build/work on HPUX and AIX, etc.
Features of Ncurses
@ -274,15 +450,15 @@
* Support for mouse event reporting with X Window xterm and FreeBSD
and OS/2 console windows.
* Extended mouse support via Alessandro Rubini's gpm package.
* The function wresize() allows you to resize windows, preserving
* The function wresize allows you to resize windows, preserving
their data.
* The function use_default_colors() allows you to use the terminal's
* The function use_default_colors allows you to use the terminal's
default colors for the default color pair, achieving the effect of
transparent colors.
* The functions keyok() and define_key() allow you to better control
the use of function keys, e.g., disabling the ncurses KEY_MOUSE,
or by defining more than one control sequence to map to a given
key code.
* The functions keyok and define_key allow you to better control the
use of function keys, e.g., disabling the ncurses KEY_MOUSE, or by
defining more than one control sequence to map to a given key
code.
* Support for 256-color terminals, such as modern xterm, when
configured using the --enable-ext-colors option.
* Support for 16-color terminals, such as aixterm and modern xterm.
@ -293,7 +469,7 @@
incorporates a novel, simple, and cheap algorithm that enables it
to make optimal use of hardware scrolling, line-insertion, and
line-deletion for screen-line movements. This algorithm is more
powerful than the 4.4BSD curses quickch() routine.
powerful than the 4.4BSD curses quickch routine.
* Real support for terminals with the magic-cookie glitch. The
screen-update code will refrain from drawing a highlight if the
magic- cookie unattributed spaces required just before the
@ -374,7 +550,7 @@
Midnight Commander
file manager
[9]http://www.ibiblio.org/mc/
[9]http://www.midnight-commander.org/
mutt
mail utility
@ -387,7 +563,7 @@
nvi
New vi versions 1.50 are able to use ncurses versions 1.9.7 and
later.
[12]http://www.bostic.com/vi/
[12]https://sites.google.com/a/bostic.com/keithbostic/nvi
pinfo
Lynx-like info browser.
@ -412,7 +588,7 @@
Who's Who and What's What
Zeyd Ben-Halim started it from a previous package pcurses, written by
Pavel Curtis. Eric S. Raymond continued development. Jürgen Pfeifer
Pavel Curtis. Eric S. Raymond continued development. Juergen Pfeifer
wrote most of the form and menu libraries. Ongoing work is being done
by [17]Thomas Dickey. Thomas Dickey acts as the maintainer for the
Free Software Foundation, which holds the copyright on ncurses.
@ -452,16 +628,16 @@ References
1. ftp://ftp.gnu.org/gnu/ncurses/
2. ftp://invisible-island.net/ncurses/
3. http://invisible-island.net/xterm/xterm.log.html#xterm_230
3. http://invisible-island.net/cindent/cindent.html
4. http://invisible-island.net/cdk/
5. http://www.vexus.ca/products/CDK/
6. http://invisible-island.net/ded/
7. http://invisible-island.net/dialog/
8. http://lynx.isc.org/release/
9. http://www.ibiblio.org/mc/
9. http://www.midnight-commander.org/
10. http://www.mutt.org/
11. http://www.ncftp.com/
12. http://www.bostic.com/vi/
12. https://sites.google.com/a/bostic.com/keithbostic/nvi
13. https://alioth.debian.org/projects/pinfo/
14. http://www.tin.org/
15. http://alioth.debian.org/projects/minicom/
@ -470,4 +646,4 @@ References
18. mailto:bug-ncurses@gnu.org
19. ftp://invisible-island.net/ncurses/
20. http://www.catb.org/~esr/terminfo/
21. http://www.cs.utk.edu/~shuford/terminal_index.html
21. http://web.archive.org/web/*/http://www.cs.utk.edu/~shuford/terminal

81
Ada95/Makefile.in Normal file
View File

@ -0,0 +1,81 @@
# $Id: Makefile.in,v 1.21 2010/11/27 21:45:27 tom Exp $
##############################################################################
# Copyright (c) 1998-2003,2010 Free Software Foundation, Inc. #
# #
# Permission is hereby granted, free of charge, to any person obtaining a #
# copy of this software and associated documentation files (the "Software"), #
# to deal in the Software without restriction, including without limitation #
# the rights to use, copy, modify, merge, publish, distribute, distribute #
# with modifications, sublicense, and/or sell copies of the Software, and to #
# permit persons to whom the Software is furnished to do so, subject to the #
# following conditions: #
# #
# The above copyright notice and this permission notice shall be included in #
# all copies or substantial portions of the Software. #
# #
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR #
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, #
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL #
# THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER #
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING #
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER #
# DEALINGS IN THE SOFTWARE. #
# #
# Except as contained in this notice, the name(s) of the above copyright #
# holders shall not be used in advertising or otherwise to promote the sale, #
# use or other dealings in this Software without prior written #
# authorization. #
##############################################################################
#
# Author: Juergen Pfeifer, 1996
#
# Version Control
# $Revision: 1.21 $
#
SHELL = /bin/sh
VPATH = @srcdir@
THIS = Makefile
SUBDIRS = @ADA_SUBDIRS@
CF_MFLAGS = @cf_cv_makeflags@
@SET_MAKE@
all \
libs \
sources \
install \
install.libs \
uninstall \
uninstall.libs ::
for d in $(SUBDIRS); do \
(cd $$d ; $(MAKE) $(CF_MFLAGS) $@) ;\
done
clean \
mostlyclean ::
for d in $(SUBDIRS); do \
(cd $$d ; $(MAKE) $(CF_MFLAGS) $@) ;\
done
distclean \
realclean ::
for d in $(SUBDIRS); do \
(cd $$d ; $(MAKE) $(CF_MFLAGS) $@) ;\
done
rm -rf lib
for lib_kind in static dynamic; do \
rm -rf $${lib_kind}-ali; \
rm -rf $${lib_kind}-obj; \
done
-rm -f config.cache config.log config.status include/ncurses_cfg.h
-rm -f Makefile
tags :
@
preinstall :
@
install.data :
@

33
Ada95/README Normal file
View File

@ -0,0 +1,33 @@
-------------------------------------------------------------------------------
-- Copyright (c) 1998 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell copies --
-- of the Software, and to permit persons to whom the Software is furnished --
-- to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN --
-- NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE --
-- USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
-------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
The documentation is provided in HTML format in the ./html
subdirectory. The main document is named index.html

55
Ada95/TODO Normal file
View File

@ -0,0 +1,55 @@
-------------------------------------------------------------------------------
-- Copyright (c) 1998-1999,2006 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell copies --
-- of the Software, and to permit persons to whom the Software is furnished --
-- to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN --
-- NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE --
-- USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
-------------------------------------------------------------------------------
-- $Id: TODO,v 1.5 2006/04/22 22:23:21 tom Exp $
-------------------------------------------------------------------------------
-- Intensive testing
Perhaps the delivery of the Beta will help a bit.
-- Documentation
Like most WEB pages: under continuous construction
-- Style cleanup
-- Alternate functions for procedures with out params
Comfort purpose
-- Sample program
Under continuous construction (and it's not a WEB page!!!)
-- Make the binding objects a shared library
They are rather large, so it would make sense, otherwise Ada95
would look too large, although the generated code is as compact
as C or C++. I'll wait a bit until the GNAT people provide some
better support to construct shared libraries.
-- Think about more inlining
-- Check for memory leaks.
Oh I would like it so much if the GNAT guys would put an optional
GC into their system.

3458
Ada95/aclocal.m4 vendored Normal file
View File

File diff suppressed because it is too large Load Diff

12189
Ada95/configure vendored Executable file
View File

File diff suppressed because it is too large Load Diff

626
Ada95/configure.in Normal file
View File

@ -0,0 +1,626 @@
dnl***************************************************************************
dnl Copyright (c) 2010 Free Software Foundation, Inc. *
dnl *
dnl Permission is hereby granted, free of charge, to any person obtaining a *
dnl copy of this software and associated documentation files (the *
dnl "Software"), to deal in the Software without restriction, including *
dnl without limitation the rights to use, copy, modify, merge, publish, *
dnl distribute, distribute with modifications, sublicense, and/or sell *
dnl copies of the Software, and to permit persons to whom the Software is *
dnl furnished to do so, subject to the following conditions: *
dnl *
dnl The above copyright notice and this permission notice shall be included *
dnl in all copies or substantial portions of the Software. *
dnl *
dnl THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS *
dnl OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *
dnl MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. *
dnl IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, *
dnl DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR *
dnl OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR *
dnl THE USE OR OTHER DEALINGS IN THE SOFTWARE. *
dnl *
dnl Except as contained in this notice, the name(s) of the above copyright *
dnl holders shall not be used in advertising or otherwise to promote the *
dnl sale, use or other dealings in this Software without prior written *
dnl authorization. *
dnl***************************************************************************
dnl
dnl Author: Thomas E. Dickey
dnl
dnl $Id: configure.in,v 1.21 2010/11/06 22:11:21 tom Exp $
dnl Process this file with autoconf to produce a configure script.
dnl
dnl See http://invisible-island.net/autoconf/ for additional information.
dnl
dnl ---------------------------------------------------------------------------
AC_PREREQ(2.13.20020210)
AC_REVISION($Revision: 1.21 $)
AC_INIT(gen/gen.c)
AC_CONFIG_HEADER(include/ncurses_cfg.h:include/ncurses_cfg.hin)
CF_TOP_BUILDDIR
CF_CHECK_CACHE([AC_CANONICAL_SYSTEM])
AC_ARG_WITH(system-type,
[ --with-system-type=XXX test: override derived host system-type],
[AC_MSG_WARN(overriding system type to $withval)
cf_cv_system_name=$withval])
### Save the given $CFLAGS to allow user-override.
cf_user_CFLAGS="$CFLAGS"
### Default install-location
CF_CFG_DEFAULTS
### Checks for programs.
AC_PROG_CC
CF_GCC_VERSION
AC_PROG_CPP
AC_PROG_GCC_TRADITIONAL
CF_PROG_CC_C_O(CC)
AC_ISC_POSIX
CF_ANSI_CC_REQD
CF_PROG_EXT
AC_ARG_PROGRAM
CF_PROG_AWK
CF_PROG_EGREP
AC_PROG_INSTALL
CF_PROG_LN_S
AC_SYS_LONG_FILE_NAMES
# if we find pkg-config, check if we should install the ".pc" files.
CF_PKG_CONFIG
if test "$PKG_CONFIG" != no ; then
AC_MSG_CHECKING(if we should install .pc files for $PKG_CONFIG)
# Leave this as something that can be overridden in the environment.
if test -z "$PKG_CONFIG_LIBDIR" ; then
PKG_CONFIG_LIBDIR=`echo "$PKG_CONFIG" | sed -e 's,/[[^/]]*/[[^/]]*$,,'`/lib/pkgconfig
fi
PKG_CONFIG_LIBDIR=`echo "$PKG_CONFIG_LIBDIR" | sed -e 's/^://' -e 's/:.*//'`
if test -n "$PKG_CONFIG_LIBDIR" && test -d "$PKG_CONFIG_LIBDIR" ; then
AC_ARG_ENABLE(pc-files,
[ --enable-pc-files generate and install .pc files for pkg-config],
[enable_pc_files=$enableval],
[enable_pc_files=no])
AC_MSG_RESULT($enable_pc_files)
else
AC_MSG_RESULT(no)
AC_MSG_WARN(did not find library $PKG_CONFIG_LIBDIR)
enable_pc_files=no
fi
fi
AC_SUBST(PKG_CONFIG_LIBDIR)
AC_MSG_CHECKING(if you want to build test-programs)
AC_ARG_WITH(tests,
[ --without-tests suppress build with test-programs],
[cf_with_tests=$withval],
[cf_with_tests=yes])
AC_MSG_RESULT($cf_with_tests)
AC_MSG_CHECKING(if we should assume mixed-case filenames)
AC_ARG_ENABLE(mixed-case,
[ --enable-mixed-case tic should assume mixed-case filenames],
[enable_mixedcase=$enableval],
[enable_mixedcase=auto])
AC_MSG_RESULT($enable_mixedcase)
if test "$enable_mixedcase" = "auto" ; then
CF_MIXEDCASE_FILENAMES
else
cf_cv_mixedcase=$enable_mixedcase
if test "$enable_mixedcase" = "yes" ; then
AC_DEFINE(MIXEDCASE_FILENAMES)
fi
fi
# do this after mixed-case option (tags/TAGS is not as important as tic).
AC_PROG_MAKE_SET
CF_MAKE_TAGS
CF_MAKEFLAGS
dnl These are standard among *NIX systems, but not when cross-compiling
AC_CHECK_TOOL(RANLIB, ranlib, ':')
AC_CHECK_TOOL(LD, ld, ld)
AC_CHECK_TOOL(AR, ar, ar)
CF_AR_FLAGS
dnl Special option for use by system-builders: the install-prefix is used to
dnl adjust the location into which the actual install is done, so that an
dnl archive can be built without modifying the host system's configuration.
AC_MSG_CHECKING(if you have specified an install-prefix)
AC_ARG_WITH(install-prefix,
[ --with-install-prefix prefixes actual install-location ($DESTDIR)],
[case "$withval" in #(vi
yes|no) #(vi
;;
*) DESTDIR="$withval"
;;
esac])
AC_MSG_RESULT($DESTDIR)
AC_SUBST(DESTDIR)
###############################################################################
CF_HELP_MESSAGE(Build-Tools Needed to Compile Temporary Applications for Cross-compiling:)
# If we're cross-compiling, allow the user to override the tools and their
# options. The configure script is oriented toward identifying the host
# compiler, etc., but we need a build compiler to generate parts of the source.
CF_BUILD_CC
###############################################################################
CF_HELP_MESSAGE(Options to Specify the Libraries Built/Used:)
### Options to allow the user to specify the set of libraries which are used.
### Use "--without-normal --with-shared" to allow the default model to be
### shared, for example.
cf_list_models=""
AC_MSG_CHECKING(for specified models)
test -z "$cf_list_models" && cf_list_models=normal
AC_MSG_RESULT($cf_list_models)
### Use the first model as the default, and save its suffix for use in building
### up test-applications.
AC_MSG_CHECKING(for default model)
DFT_LWR_MODEL=`echo "$cf_list_models" | $AWK '{print $1}'`
AC_MSG_RESULT($DFT_LWR_MODEL)
CF_UPPER(DFT_UPR_MODEL,$DFT_LWR_MODEL)dnl
AC_SUBST(DFT_LWR_MODEL)dnl the default model ("normal")
AC_SUBST(DFT_UPR_MODEL)dnl the default model ("NORMAL")
CF_NCURSES_ADDON
CF_LIB_PREFIX(cf_prefix)
LIB_PREFIX=$cf_prefix
AC_SUBST(LIB_PREFIX)
LIB_SUFFIX=
AC_SUBST(LIB_SUFFIX)
###############################################################################
dnl Not all ports of gcc support the -g option
if test X"$CC_G_OPT" = X"" ; then
CC_G_OPT='-g'
test -n "$GCC" && test "${ac_cv_prog_cc_g}" != yes && CC_G_OPT=''
fi
AC_SUBST(CC_G_OPT)
AC_MSG_CHECKING(for default loader flags)
case $DFT_LWR_MODEL in
normal) LD_MODEL='' ;;
debug) LD_MODEL=$CC_G_OPT ;;
profile) LD_MODEL='-pg';;
shared) LD_MODEL='' ;;
esac
AC_SUBST(LD_MODEL)dnl the type of link (e.g., -g or -pg)
AC_MSG_RESULT($LD_MODEL)
CF_SHARED_OPTS
###############################################################################
CF_HELP_MESSAGE(Fine-Tuning Your Configuration:)
CF_PATHSEP
### use option --enable-broken-linker to force on use of broken-linker support
AC_MSG_CHECKING(if you want broken-linker support code)
AC_ARG_ENABLE(broken_linker,
[ --enable-broken_linker compile with broken-linker support code],
[with_broken_linker=$enableval],
[with_broken_linker=${BROKEN_LINKER:-no}])
AC_MSG_RESULT($with_broken_linker)
BROKEN_LINKER=0
if test "$with_broken_linker" = yes ; then
AC_DEFINE(BROKEN_LINKER)
BROKEN_LINKER=1
elif test "$DFT_LWR_MODEL" = shared ; then
case $cf_cv_system_name in #(vi
cygwin*)
AC_DEFINE(BROKEN_LINKER)
BROKEN_LINKER=1
CF_VERBOSE(cygwin linker is broken anyway)
;;
esac
fi
AC_SUBST(BROKEN_LINKER)
# Check to define _XOPEN_SOURCE "automatically"
CF_XOPEN_SOURCE
CF_LARGEFILE
### Enable compiling-in rcs id's
AC_MSG_CHECKING(if RCS identifiers should be compiled-in)
AC_ARG_WITH(rcs-ids,
[ --with-rcs-ids compile-in RCS identifiers],
[with_rcs_ids=$withval],
[with_rcs_ids=no])
AC_MSG_RESULT($with_rcs_ids)
test "$with_rcs_ids" = yes && AC_DEFINE(USE_RCS_IDS)
###############################################################################
CF_HELP_MESSAGE(Extensions:)
### Note that some functions (such as const) are normally disabled anyway.
AC_MSG_CHECKING(if you want to build with function extensions)
AC_ARG_ENABLE(ext-funcs,
[ --disable-ext-funcs disable function-extensions],
[with_ext_funcs=$enableval],
[with_ext_funcs=yes])
AC_MSG_RESULT($with_ext_funcs)
if test "$with_ext_funcs" = yes ; then
NCURSES_EXT_FUNCS=1
AC_DEFINE(HAVE_USE_DEFAULT_COLORS)
AC_DEFINE(NCURSES_EXT_FUNCS)
else
NCURSES_EXT_FUNCS=0
fi
AC_SUBST(NCURSES_EXT_FUNCS)
### use option --enable-const to turn on use of const beyond that in XSI.
AC_MSG_CHECKING(for extended use of const keyword)
AC_ARG_ENABLE(const,
[ --enable-const compile with extra/non-standard const],
[with_ext_const=$enableval],
[with_ext_const=no])
AC_MSG_RESULT($with_ext_const)
NCURSES_CONST='/*nothing*/'
if test "$with_ext_const" = yes ; then
NCURSES_CONST=const
fi
AC_SUBST(NCURSES_CONST)
###############################################################################
# These options are relatively safe to experiment with.
CF_HELP_MESSAGE(Development Code:)
AC_MSG_CHECKING(if you want all development code)
AC_ARG_WITH(develop,
[ --without-develop disable development options],
[with_develop=$withval],
[with_develop=no])
AC_MSG_RESULT($with_develop)
###############################################################################
# These are just experimental, probably should not be in a package:
CF_HELP_MESSAGE(Experimental Code:)
# This is still experimental (20080329), but should ultimately be moved to
# the script-block --with-normal, etc.
CF_WITH_PTHREAD
AC_MSG_CHECKING(if you want to use weak-symbols for pthreads)
AC_ARG_ENABLE(weak-symbols,
[ --enable-weak-symbols enable weak-symbols for pthreads],
[use_weak_symbols=$withval],
[use_weak_symbols=no])
AC_MSG_RESULT($use_weak_symbols)
if test "$use_weak_symbols" = yes ; then
CF_WEAK_SYMBOLS
else
cf_cv_weak_symbols=no
fi
if test $cf_cv_weak_symbols = yes ; then
AC_DEFINE(USE_WEAK_SYMBOLS)
fi
PTHREAD=
if test "$with_pthread" = "yes" ; then
AC_DEFINE(USE_PTHREADS)
enable_reentrant=yes
if test $cf_cv_weak_symbols = yes ; then
PTHREAD=-lpthread
fi
fi
AC_SUBST(PTHREAD)
# Reentrant code has to be opaque; there's little advantage to making ncurses
# opaque outside of that, so there is no --enable-opaque option. We can use
# this option without --with-pthreads, but this will be always set for
# pthreads.
AC_MSG_CHECKING(if you want experimental reentrant code)
AC_ARG_ENABLE(reentrant,
[ --enable-reentrant compile with experimental reentrant code],
[with_reentrant=$enableval],
[with_reentrant=no])
AC_MSG_RESULT($with_reentrant)
if test "$with_reentrant" = yes ; then
cf_cv_enable_reentrant=1
if test $cf_cv_weak_symbols = yes ; then
CF_REMOVE_LIB(LIBS,$LIBS,pthread)
else
LIB_SUFFIX="t${LIB_SUFFIX}"
fi
AC_DEFINE(USE_REENTRANT)
else
cf_cv_enable_reentrant=0
fi
AC_SUBST(cf_cv_enable_reentrant)
### Allow using a different wrap-prefix
if test "$cf_cv_enable_reentrant" != 0 || test "$BROKEN_LINKER" = 1 ; then
AC_MSG_CHECKING(for prefix used to wrap public variables)
AC_ARG_WITH(wrap-prefix,
[ --with-wrap-prefix=XXX override prefix used for public variables],
[NCURSES_WRAP_PREFIX=$withval],
[NCURSES_WRAP_PREFIX=_nc_])
AC_MSG_RESULT($NCURSES_WRAP_PREFIX)
else
NCURSES_WRAP_PREFIX=_nc_
fi
AC_SUBST(NCURSES_WRAP_PREFIX)
AC_DEFINE_UNQUOTED(NCURSES_WRAP_PREFIX,"$NCURSES_WRAP_PREFIX")
###############################################################################
CF_HELP_MESSAGE(Testing/development Options:)
### use option --disable-echo to suppress full display compiling commands
AC_MSG_CHECKING(if you want to display full commands during build)
AC_ARG_ENABLE(echo,
[ --enable-echo build: display "compiling" commands (default)],
[with_echo=$enableval],
[with_echo=yes])
if test "$with_echo" = yes; then
ECHO_LINK=
else
ECHO_LINK='@ echo linking $@ ... ;'
fi
AC_MSG_RESULT($with_echo)
AC_SUBST(ECHO_LINK)
### use option --enable-warnings to turn on all gcc warnings
AC_MSG_CHECKING(if you want to see compiler warnings)
AC_ARG_ENABLE(warnings,
[ --enable-warnings build: turn on GCC compiler warnings],
[with_warnings=$enableval])
AC_MSG_RESULT($with_warnings)
if test "x$with_warnings" = "xyes"; then
ADAFLAGS="$ADAFLAGS -gnatg"
CF_GCC_WARNINGS(Wdeclaration-after-statement Wextra Wno-unknown-pragmas Wswitch-enum)
fi
CF_GCC_ATTRIBUTES
### use option --enable-assertions to turn on generation of assertion code
AC_MSG_CHECKING(if you want to enable runtime assertions)
AC_ARG_ENABLE(assertions,
[ --enable-assertions test: turn on generation of assertion code],
[with_assertions=$enableval],
[with_assertions=no])
AC_MSG_RESULT($with_assertions)
if test -n "$GCC"
then
if test "$with_assertions" = no
then
AC_DEFINE(NDEBUG)
CPPFLAGS="$CPPFLAGS -DNDEBUG"
else
ADAFLAGS="$ADAFLAGS -gnata"
fi
fi
### use option --disable-leaks to suppress "permanent" leaks, for testing
AC_DEFINE(HAVE_NC_ALLOC_H)
### use option --enable-expanded to generate certain macros as functions
AC_ARG_ENABLE(expanded,
[ --enable-expanded test: generate functions for certain macros],
[test "$enableval" = yes && AC_DEFINE(NCURSES_EXPANDED)])
### use option --disable-macros to suppress macros in favor of functions
AC_ARG_ENABLE(macros,
[ --disable-macros test: use functions rather than macros],
[test "$enableval" = no && AC_DEFINE(NCURSES_NOMACROS)])
# Normally we only add trace() to the debug-library. Allow this to be
# extended to all models of the ncurses library:
cf_all_traces=no
case "$CFLAGS $CPPFLAGS" in
*-DTRACE*)
cf_all_traces=yes
;;
esac
AC_MSG_CHECKING(whether to add trace feature to all models)
AC_ARG_WITH(trace,
[ --with-trace test: add trace() function to all models of ncurses],
[cf_with_trace=$withval],
[cf_with_trace=$cf_all_traces])
AC_MSG_RESULT($cf_with_trace)
if test "$cf_with_trace" = yes ; then
ADA_TRACE=TRUE
CF_ADD_CFLAGS(-DTRACE)
else
ADA_TRACE=FALSE
fi
AC_SUBST(ADA_TRACE)
### Checks for libraries.
case $cf_cv_system_name in #(vi
*mingw32*) #(vi
;;
*)
AC_CHECK_FUNC(gettimeofday,
AC_DEFINE(HAVE_GETTIMEOFDAY),[
AC_CHECK_LIB(bsd, gettimeofday,
AC_DEFINE(HAVE_GETTIMEOFDAY)
LIBS="$LIBS -lbsd")])dnl CLIX: bzero, select, gettimeofday
;;
esac
### Checks for header files.
AC_STDC_HEADERS
AC_HEADER_DIRENT
AC_HEADER_TIME
### checks for compiler characteristics
AC_LANG_C
AC_C_CONST
### Checks for external-data
CF_LINK_DATAONLY
### Checks for library functions.
CF_MKSTEMP
AC_TYPE_SIGNAL
dnl We'll do our own -g libraries, unless the user's overridden via $CFLAGS
if test -z "$cf_user_CFLAGS" && test "$with_no_leaks" = no ; then
CF_STRIP_G_OPT(CFLAGS)
CF_STRIP_G_OPT(CXXFLAGS)
fi
CF_HELP_MESSAGE(Ada95 Binding Options:)
dnl Check for availability of GNU Ada Translator (GNAT).
dnl At the moment we support no other Ada95 compiler.
if test "$cf_with_ada" != "no" ; then
CF_PROG_GNAT
if test "$cf_cv_prog_gnat_correct" = yes; then
CF_ADD_ADAFLAGS(-O3 -gnatpn)
CF_GNAT_PRAGMA_UNREF
CF_WITH_ADA_COMPILER
cf_ada_package=terminal_interface
AC_SUBST(cf_ada_package)
CF_WITH_ADA_INCLUDE
CF_WITH_ADA_OBJECTS
CF_WITH_ADA_SHAREDLIB
fi
fi
################################################################################
# not needed
TINFO_ARGS2=
AC_SUBST(TINFO_ARGS2)
### Construct the list of include-directories to be generated
CF_INCLUDE_DIRS
CF_ADA_INCLUDE_DIRS
### Build up pieces for makefile rules
AC_MSG_CHECKING(default library suffix)
CF_LIB_TYPE($DFT_LWR_MODEL,DFT_ARG_SUFFIX)dnl
AC_SUBST(DFT_ARG_SUFFIX)dnl the string to append to "-lncurses" ("")
AC_MSG_RESULT($DFT_ARG_SUFFIX)
AC_MSG_CHECKING(default library-dependency suffix)
CF_LIB_SUFFIX($DFT_LWR_MODEL,DFT_LIB_SUFFIX,DFT_DEP_SUFFIX)dnl
AC_SUBST(DFT_DEP_SUFFIX)dnl the corresponding library-suffix (".a")
AC_MSG_RESULT($DFT_DEP_SUFFIX)
AC_MSG_CHECKING(default object directory)
CF_OBJ_SUBDIR($DFT_LWR_MODEL,DFT_OBJ_SUBDIR)dnl
AC_SUBST(DFT_OBJ_SUBDIR)dnl the default object-directory ("obj")
AC_MSG_RESULT($DFT_OBJ_SUBDIR)
### Set up low-level terminfo dependencies for makefiles.
if test "$DFT_LWR_MODEL" = shared ; then
case $cf_cv_system_name in #(vi
cygwin*)
# "lib" files have ".dll.a" suffix, "cyg" files have ".dll"
;;
esac
fi
### Construct the list of subdirectories for which we'll customize makefiles
### with the appropriate compile-rules.
SUB_MAKEFILES="gen/adacurses${DFT_ARG_SUFFIX}-config:gen/adacurses-config.in"
AC_DEFINE_UNQUOTED(NCURSES_PATHSEP,'$PATH_SEPARATOR')
### Now that we're done running tests, add the compiler-warnings, if any
CF_ADD_CFLAGS($EXTRA_CFLAGS)
################################################################################
if test x"$enable_pc_files" = xyes ; then \
SUB_MAKEFILES="$SUB_MAKEFILES misc/gen-pkgconfig:misc/gen-pkgconfig.in"
MAKE_PC_FILES=
else
MAKE_PC_FILES="#"
fi
AC_SUBST(MAKE_PC_FILES)
AC_SUBST(cross_compiling)
################################################################################
TEST_ARG2=
AC_SUBST(TEST_ARG2)
TEST_LIBS2=
AC_SUBST(TEST_LIBS2)
dnl for separate build, this is good enough for "sh $(top_srcdir)/misc/shlib"
NCURSES_SHLIB2="sh -c"
AC_SUBST(NCURSES_SHLIB2)
ADA_SUBDIRS="include gen src"
if test "x$cf_with_tests" != "xno" ; then
ADA_SUBDIRS="$ADA_SUBDIRS samples"
fi
for cf_dir in $ADA_SUBDIRS
do
SUB_MAKEFILES="$SUB_MAKEFILES $cf_dir/Makefile"
done
AC_SUBST(ADA_SUBDIRS)
NCURSES_TREE="#"
AC_SUBST(NCURSES_TREE)
EXTERNAL_TREE=
AC_SUBST(EXTERNAL_TREE)
AC_OUTPUT( \
$SUB_MAKEFILES \
Makefile,[
if test -z "$USE_OLD_MAKERULES" ; then
$AWK -f $srcdir/mk-1st.awk <$srcdir/src/modules >>src/Makefile
fi
],[
### Special initialization commands, used to pass information from the
### configuration-run into config.status
AWK="$AWK"
DFT_ARG_SUFFIX="$DFT_ARG_SUFFIX"
DFT_LWR_MODEL="$DFT_LWR_MODEL"
ECHO_LINK="$ECHO_LINK"
LIB_NAME="$LIB_NAME"
LIB_SUFFIX="$LIB_SUFFIX"
LN_S="$LN_S"
NCURSES_MAJOR="$NCURSES_MAJOR"
NCURSES_MINOR="$NCURSES_MINOR"
NCURSES_PATCH="$NCURSES_PATCH"
USE_OLD_MAKERULES="$USE_OLD_MAKERULES"
cf_cv_abi_version="$cf_cv_abi_version"
cf_cv_rel_version="$cf_cv_rel_version"
cf_cv_rm_so_locs="$cf_cv_rm_so_locs"
cf_cv_shared_soname='$cf_cv_shared_soname'
cf_cv_shlib_version="$cf_cv_shlib_version"
cf_cv_shlib_version_infix="$cf_cv_shlib_version_infix"
cf_cv_system_name="$cf_cv_system_name"
host="$host"
target="$target"
],cat)dnl
${MAKE:-make} preinstall

449
Ada95/gen/Makefile.in Normal file
View File

@ -0,0 +1,449 @@
##############################################################################
# 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.71 2011/01/22 19:47:09 tom Exp $
#
.SUFFIXES:
SHELL = /bin/sh
VPATH = @srcdir@
THIS = Makefile
x = @PROG_EXT@
top_srcdir = @top_srcdir@
DESTDIR = @DESTDIR@
srcdir = @srcdir@
prefix = @prefix@
exec_prefix = @exec_prefix@
bindir = @bindir@
includedir = @includedir@
INSTALL = @INSTALL@
INSTALL_PROG = @INSTALL_PROGRAM@
INSTALL_DATA = @INSTALL_DATA@
AWK = @AWK@
LN_S = @LN_S@
CC = @CC@
HOST_CC = @BUILD_CC@
CFLAGS = @CFLAGS@
CPPFLAGS = @ACPPFLAGS@ \
-DHAVE_CONFIG_H -I$(srcdir)
CCFLAGS = $(CPPFLAGS) $(CFLAGS)
CFLAGS_NORMAL = $(CCFLAGS)
CFLAGS_DEBUG = $(CCFLAGS) @CC_G_OPT@ -DTRACE
CFLAGS_PROFILE = $(CCFLAGS) -pg
CFLAGS_SHARED = $(CCFLAGS) @CC_SHARED_OPTS@
CFLAGS_DEFAULT = $(CFLAGS_@DFT_UPR_MODEL@)
REL_VERSION = @cf_cv_rel_version@
ABI_VERSION = @cf_cv_abi_version@
LOCAL_LIBDIR = @top_builddir@/lib
LINK = $(HOST_CC)
LD_FLAGS = @LD_MODEL@ $(LOCAL_LIBS) @LDFLAGS@ @LIBS@ @LOCAL_LDFLAGS2@ $(LDFLAGS) @TINFO_ARGS2@
RANLIB = @RANLIB@
M4 = m4
M4FLAGS = -DNCURSES_EXT_FUNCS=@NCURSES_EXT_FUNCS@
ADACURSES_CONFIG = adacurses@DFT_ARG_SUFFIX@-config
WRAPPER = @NCURSES_SHLIB2@
PROG_GENERATE = ./generate$x
GENERATE = $(PROG_GENERATE) '@DFT_ARG_SUFFIX@'
DEL_ADAMODE = sed -e '/^\-\-\ \ \-\*\-\ ada\ \-\*\-.*/d'
GNATHTML = `type -p gnathtml || type -p gnathtml.pl`
GNATHP = www.gnat.com
################################################################################
ALIB = @cf_ada_package@
ABASE = $(ALIB)-curses
ADA_SRCDIR = ../src
GEN_FILES0 = Base_Defs
GEN_FILES1 = ACS_Map \
AC_Rep \
Base_Defs \
Character_Attribute_Set_Rep \
Color_Defs \
Key_Definitions \
Linker_Options \
Old_Keys \
Public_Variables \
Trace_Defs \
Version_Info \
Window_Offsets
GEN_FILES2 = Menu_Opt_Rep \
Menu_Base_Defs \
Menu_Linker_Options \
Item_Rep
GEN_FILES3 = Form_Opt_Rep \
Form_Base_Defs \
Form_Linker_Options \
Field_Rep
GEN_FILES4 = Mouse_Base_Defs \
Mouse_Event_Rep \
Mouse_Events \
Panel_Linker_Options
GEN_FILES5 = Chtype_Def \
Eti_Defs
GEN_TARGETS = $(ADA_SRCDIR)/$(ABASE).ads \
$(ADA_SRCDIR)/$(ABASE).adb \
$(ADA_SRCDIR)/$(ABASE)-aux.ads \
$(ADA_SRCDIR)/$(ABASE)-trace.ads \
$(ADA_SRCDIR)/$(ABASE)-menus.ads \
$(ADA_SRCDIR)/$(ABASE)-forms.ads \
$(ADA_SRCDIR)/$(ABASE)-mouse.ads \
$(ADA_SRCDIR)/$(ABASE)-panels.ads \
$(ADA_SRCDIR)/$(ABASE)-menus-menu_user_data.ads \
$(ADA_SRCDIR)/$(ABASE)-menus-item_user_data.ads \
$(ADA_SRCDIR)/$(ABASE)-forms-form_user_data.ads \
$(ADA_SRCDIR)/$(ABASE)-forms-field_types.ads \
$(ADA_SRCDIR)/$(ABASE)-forms-field_user_data.ads \
$(ADA_SRCDIR)/$(ABASE)-panels-user_data.ads
GEN_SRC = $(srcdir)/$(ABASE).ads.m4 \
$(srcdir)/$(ABASE).adb.m4 \
$(srcdir)/$(ABASE)-aux.ads.m4 \
$(srcdir)/$(ABASE)-trace.ads.m4 \
$(srcdir)/$(ABASE)-menus.ads.m4 \
$(srcdir)/$(ABASE)-forms.ads.m4 \
$(srcdir)/$(ABASE)-mouse.ads.m4 \
$(srcdir)/$(ABASE)-panels.ads.m4 \
$(srcdir)/$(ABASE)-menus-menu_user_data.ads.m4 \
$(srcdir)/$(ABASE)-menus-item_user_data.ads.m4 \
$(srcdir)/$(ABASE)-forms-form_user_data.ads.m4 \
$(srcdir)/$(ABASE)-forms-field_types.ads.m4 \
$(srcdir)/$(ABASE)-forms-field_user_data.ads.m4 \
$(srcdir)/$(ABASE)-panels-user_data.ads.m4
all \
libs : $(GEN_TARGETS)
@echo made $@
sources:
$(DESTDIR)$(bindir) :
mkdir -p $@
install \
install.libs :: $(DESTDIR)$(bindir) $(ADACURSES_CONFIG)
$(INSTALL_PROG) $(ADACURSES_CONFIG) $(DESTDIR)$(bindir)/$(ADACURSES_CONFIG)
uninstall \
uninstall.libs ::
-rm -f $(DESTDIR)$(bindir)/$(ADACURSES_CONFIG)
$(PROG_GENERATE): gen.o
@ECHO_LINK@ $(LINK) $(CFLAGS_NORMAL) gen.o $(LD_FLAGS) -o $@
gen.o: $(srcdir)/gen.c
$(HOST_CC) $(CFLAGS_NORMAL) -c -o $@ $(srcdir)/gen.c
################################################################################
Character_Attribute_Set_Rep: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) B A" >$@
Base_Defs: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) B B" >$@
Color_Defs: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) B C" >$@
Window_Offsets: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) B D" >$@
Key_Definitions: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) B K" >$@
Linker_Options: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) B L" >$@
ACS_Map: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) B M" >$@
Old_Keys: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) B O" >$@
Public_Variables: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) B P" >$@
AC_Rep: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) B R" >$@
Version_Info: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) B V" >$@
Trace_Defs: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) B T" >$@
################################################################################
Menu_Opt_Rep: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) M R" >$@
Menu_Base_Defs: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) M B" >$@
Menu_Linker_Options: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) M L" >$@
Item_Rep: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) M I" >$@
################################################################################
Form_Opt_Rep: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) F R" >$@
Form_Base_Defs: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) F B" >$@
Form_Linker_Options: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) F L" >$@
Field_Rep: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) F I" >$@
################################################################################
Mouse_Base_Defs: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) P B" >$@
Mouse_Event_Rep: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) P M" >$@
Mouse_Events: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) B E" >$@
Panel_Linker_Options: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) P L" >$@
Chtype_Def: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) E C" >$@
Eti_Defs: $(PROG_GENERATE)
$(WRAPPER) "$(GENERATE) E E" >$@
################################################################################
$(ADA_SRCDIR)/$(ABASE).ads: $(srcdir)/$(ABASE).ads.m4 \
$(GEN_FILES1) $(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE).ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE).adb: $(srcdir)/$(ABASE).adb.m4 \
$(GEN_FILES1) $(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE).adb.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-aux.ads: $(srcdir)/$(ABASE)-aux.ads.m4 \
$(GEN_FILES5) $(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-aux.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-trace.ads: $(srcdir)/$(ABASE)-trace.ads.m4 \
$(GEN_FILES5) $(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-trace.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-menus.ads: $(srcdir)/$(ABASE)-menus.ads.m4 \
$(GEN_FILES2) $(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-menus.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-forms.ads: $(srcdir)/$(ABASE)-forms.ads.m4 \
$(GEN_FILES3) $(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-forms.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-mouse.ads: $(srcdir)/$(ABASE)-mouse.ads.m4 \
$(GEN_FILES4) $(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-mouse.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-panels.ads: $(srcdir)/$(ABASE)-panels.ads.m4 \
$(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-panels.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-menus-menu_user_data.ads: \
$(srcdir)/$(ABASE)-menus-menu_user_data.ads.m4 \
$(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-menus-menu_user_data.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-menus-item_user_data.ads: \
$(srcdir)/$(ABASE)-menus-item_user_data.ads.m4 \
$(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-menus-item_user_data.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-forms-form_user_data.ads: \
$(srcdir)/$(ABASE)-forms-form_user_data.ads.m4 \
$(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-forms-form_user_data.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-forms-field_types.ads: \
$(srcdir)/$(ABASE)-forms-field_types.ads.m4 \
$(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-forms-field_types.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-forms-field_user_data.ads: \
$(srcdir)/$(ABASE)-forms-field_user_data.ads.m4 \
$(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-forms-field_user_data.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-panels-user_data.ads: \
$(srcdir)/$(ABASE)-panels-user_data.ads.m4 \
$(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-panels-user_data.ads.m4 |\
$(DEL_ADAMODE) >$@
install.progs ::
tags:
ctags *.[ch]
@MAKE_UPPER_TAGS@TAGS:
@MAKE_UPPER_TAGS@ etags *.[ch]
mostlyclean ::
-rm -f a.out core $(PROG_GENERATE) *.o
-rm -f $(GEN_FILES1)
-rm -f $(GEN_FILES2)
-rm -f $(GEN_FILES3)
-rm -f $(GEN_FILES4)
-rm -f $(GEN_FILES5)
clean :: mostlyclean
-rm -f $(GEN_TARGETS) instab.tmp *.ad[bs] *.html *.ali *.tmp
distclean :: clean
-rm -f $(ADACURSES_CONFIG)
-rm -f Makefile
realclean :: distclean
HTML_DIR = ../../doc/html/ada
instab.tmp : table.m4 $(GEN_SRC)
@rm -f $@
@for f in $(GEN_SRC) ; do \
$(M4) $(M4FLAGS) -DM4MACRO=table.m4 $$f | $(DEL_ADAMODE) >> $@ ;\
done;
$(HTML_DIR)/table.html : instab.tmp
@-touch $@
@-chmod +w $@
@echo '<!DOCTYPE HTML' > $@
@echo 'PUBLIC "-//IETF//DTD HTML 3.0//EN">' >> $@
@echo '<HTML>' >> $@
@echo '<HEAD>' >> $@
@echo '<TITLE>Correspondence between ncurses C and Ada functions</TITLE>' >>$@
@echo '</HEAD>' >> $@
@echo '<BODY>' >> $@
@echo '<H1>Correspondence between ncurses C and Ada functions</H1>' >>$@
@echo '<H2>Sorted by C function name</H2>' >>$@
@echo '<TABLE ALIGN=CENTER BORDER>' >>$@
@echo '<TR ALIGN=LEFT>' >>$@
@echo '<TH>C name</TH><TH>Ada name</TH><TH>man page</TH></TR>' >>$@
@sort < instab.tmp >> $@
@echo '</TABLE></BODY></HTML>' >>$@
@rm -f instab.tmp
adahtml:
@find $(HTML_DIR) -type f -exec rm -f {} \;
@mkdir -p $(HTML_DIR)
cp -p ../src/*.ad[sb] . && chmod +w *.ad[sb]
@USE_OLD_MAKERULES@ ln -sf ../src/*.ali .
@USE_GNAT_PROJECTS@ ln -sf ../static-ali/*.ali .
@echo "Filtering generated files"
@for f in $(GEN_SRC); do \
h=`basename $$f` ;\
g=`basename $$f .ads.m4` ;\
if test "$$g" != "$$h" ; then \
$(M4) $(M4FLAGS) -DM4MACRO=html.m4 $$f | $(DEL_ADAMODE) > $$g.ads ;\
echo "... $$g.ads" ;\
fi \
done
@-rm -f $(HTML_DIR)/$(ALIB)*.htm*
$(GNATHTML) -d -f $(ALIB)*.ads
for f in html/$(ALIB)*.htm*; do \
a=`basename $$f` ; \
sed -e 's/You may also.*body.*//' <$$f |\
sed -e 's%GNAT%<A HREF="http://$(GNATHP)">GNAT</A>%g' |\
sed -e 's%&lt;A HREF%<A HREF%g' |\
sed -e 's%"&gt;%">%g' |\
sed -e 's/3X/3x/g' |\
sed -e 's/$$\([ABCDEFGHIJKLMNOPQRSTUVWXZabcdefghijklmnopqrstuvwxz0123456789_]*:.*\)\$$/@\1@/' |\
sed -e 's%&lt;/A&gt;%</A>%g' > $$a.tmp ;\
mv $$a.tmp $$f ;\
done
@rm -f *.ad[sb] *.ali *.tmp
@for f in funcs.htm main.htm ; do \
sed -e "\%<A HREF=funcs/ .htm>\[ \]</A>%d" < html/$$f > $$f ;\
mv $$f html/$$f ;\
done
@rm -f "html/funcs/ .htm"
@cp -pdrf html/* $(HTML_DIR)/
@rm -rf html
html : adahtml $(HTML_DIR)/table.html
@echo made $@
###############################################################################
# The remainder of this file is automatically generated during configuration
###############################################################################

79
Ada95/gen/adacurses-config.in Normal file
View File

@ -0,0 +1,79 @@
#! /bin/sh
# $Id: adacurses-config.in,v 1.6 2010/03/06 21:05:01 tom Exp $
##############################################################################
# Copyright (c) 2007-2009,2010 Free Software Foundation, Inc. #
# #
# Permission is hereby granted, free of charge, to any person obtaining a #
# copy of this software and associated documentation files (the "Software"), #
# to deal in the Software without restriction, including without limitation #
# the rights to use, copy, modify, merge, publish, distribute, distribute #
# with modifications, sublicense, and/or sell copies of the Software, and to #
# permit persons to whom the Software is furnished to do so, subject to the #
# following conditions: #
# #
# The above copyright notice and this permission notice shall be included in #
# all copies or substantial portions of the Software. #
# #
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR #
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, #
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL #
# THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER #
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING #
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER #
# DEALINGS IN THE SOFTWARE. #
# #
# Except as contained in this notice, the name(s) of the above copyright #
# holders shall not be used in advertising or otherwise to promote the sale, #
# use or other dealings in this Software without prior written #
# authorization. #
##############################################################################
#
# This script returns the options to add to `gnatmake' for using AdaCurses.
DESTDIR=@DESTDIR@
prefix=@prefix@
exec_prefix=@exec_prefix@
libdir=@libdir@
ADA_INCLUDE=@ADA_INCLUDE@
ADA_OBJECTS=@ADA_OBJECTS@
VERSION=@NCURSES_MAJOR@.@NCURSES_MINOR@.@NCURSES_PATCH@
CFLAGS="-I$ADA_INCLUDE -aO$ADA_OBJECTS"
LIBS="-L$ADA_OBJECTS -lAdaCurses"
THIS="adacurses"
case "x$1" in
x--version)
echo AdaCurses $VERSION
;;
x--cflags)
echo $CFLAGS
;;
x--libs)
echo $LIBS
;;
x)
# if no parameter is given, give what gnatmake needs
echo "$CFLAGS -i -largs $LIBS"
;;
x--help)
cat <<ENDHELP
Usage: ${THIS}-config [options]
Options:
--cflags echos the C compiler flags needed to compile with ${THIS}
--libs echos the libraries needed to link with ${THIS}
--version echos the release+patchdate version of ${THIS}
--help prints this message
ENDHELP
;;
*)
echo 'Usage: adacurses@DFT_ARG_SUFFIX@-config [--version | --cflags | --libs]' >&2
exit 1
;;
esac

1537
Ada95/gen/gen.c Normal file
View File

File diff suppressed because it is too large Load Diff

40
Ada95/gen/html.m4 Normal file
View File

@ -0,0 +1,40 @@
dnl***************************************************************************
dnl Copyright (c) 2000-2006,2007 Free Software Foundation, Inc. *
dnl *
dnl Permission is hereby granted, free of charge, to any person obtaining a *
dnl copy of this software and associated documentation files (the *
dnl "Software"), to deal in the Software without restriction, including *
dnl without limitation the rights to use, copy, modify, merge, publish, *
dnl distribute, distribute with modifications, sublicense, and/or sell *
dnl copies of the Software, and to permit persons to whom the Software is *
dnl furnished to do so, subject to the following conditions: *
dnl *
dnl The above copyright notice and this permission notice shall be included *
dnl in all copies or substantial portions of the Software. *
dnl *
dnl THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS *
dnl OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *
dnl MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. *
dnl IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, *
dnl DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR *
dnl OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR *
dnl THE USE OR OTHER DEALINGS IN THE SOFTWARE. *
dnl *
dnl Except as contained in this notice, the name(s) of the above copyright *
dnl holders shall not be used in advertising or otherwise to promote the *
dnl sale, use or other dealings in this Software without prior written *
dnl authorization. *
dnl***************************************************************************
dnl
dnl $Id: html.m4,v 1.3 2007/09/01 23:59:59 tom Exp $
define(`ANCHORIDX',`0')dnl
define(`MANPAGE',`define(`MANPG',$1)dnl
|=====================================================================
-- | Man page <A HREF="../man/MANPG.html">MANPG</A>
-- |=====================================================================')dnl
define(`ANCHOR',`define(`ANCHORIDX',incr(ANCHORIDX))dnl
`#'1A NAME="AFU`_'ANCHORIDX"`#'2dnl
define(`CFUNAME',`$1')define(`AFUNAME',`$2')dnl
|')dnl
define(`AKA',``AKA': <A HREF="../man/MANPG.html">CFUNAME</A>')dnl
define(`ALIAS',``AKA': $1')dnl

37
Ada95/gen/normal.m4 Normal file
View File

@ -0,0 +1,37 @@
dnl***************************************************************************
dnl Copyright (c) 1998,2006 Free Software Foundation, Inc. *
dnl *
dnl Permission is hereby granted, free of charge, to any person obtaining a *
dnl copy of this software and associated documentation files (the *
dnl "Software"), to deal in the Software without restriction, including *
dnl without limitation the rights to use, copy, modify, merge, publish, *
dnl distribute, distribute with modifications, sublicense, and/or sell *
dnl copies of the Software, and to permit persons to whom the Software is *
dnl furnished to do so, subject to the following conditions: *
dnl *
dnl The above copyright notice and this permission notice shall be included *
dnl in all copies or substantial portions of the Software. *
dnl *
dnl THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS *
dnl OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *
dnl MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. *
dnl IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, *
dnl DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR *
dnl OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR *
dnl THE USE OR OTHER DEALINGS IN THE SOFTWARE. *
dnl *
dnl Except as contained in this notice, the name(s) of the above copyright *
dnl holders shall not be used in advertising or otherwise to promote the *
dnl sale, use or other dealings in this Software without prior written *
dnl authorization. *
dnl***************************************************************************
dnl
dnl $Id: normal.m4,v 1.2 2006/04/22 23:16:14 tom Exp $
define(`MANPAGE',`define(`MANPG',$1)dnl
|=====================================================================
-- | Man page MANPG
-- |=====================================================================')dnl
define(`ANCHOR',`define(`CFUNAME',`$1')define(`AFUNAME',`$2')'dnl
|)dnl
define(`AKA',``AKA': CFUNAME')dnl
define(`ALIAS',``AKA': $1')dnl

35
Ada95/gen/table.m4 Normal file
View File

@ -0,0 +1,35 @@
dnl***************************************************************************
dnl Copyright (c) 2000,2006 Free Software Foundation, Inc. *
dnl *
dnl Permission is hereby granted, free of charge, to any person obtaining a *
dnl copy of this software and associated documentation files (the *
dnl "Software"), to deal in the Software without restriction, including *
dnl without limitation the rights to use, copy, modify, merge, publish, *
dnl distribute, distribute with modifications, sublicense, and/or sell *
dnl copies of the Software, and to permit persons to whom the Software is *
dnl furnished to do so, subject to the following conditions: *
dnl *
dnl The above copyright notice and this permission notice shall be included *
dnl in all copies or substantial portions of the Software. *
dnl *
dnl THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS *
dnl OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *
dnl MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. *
dnl IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, *
dnl DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR *
dnl OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR *
dnl THE USE OR OTHER DEALINGS IN THE SOFTWARE. *
dnl *
dnl Except as contained in this notice, the name(s) of the above copyright *
dnl holders shall not be used in advertising or otherwise to promote the *
dnl sale, use or other dealings in this Software without prior written *
dnl authorization. *
dnl***************************************************************************
dnl
dnl $Id: table.m4,v 1.2 2006/04/22 23:16:44 tom Exp $
define(`ANCHORIDX',`0')dnl
define(`MANPAGE',`define(`MANPG',$1)')dnl
divert(-1)dnl
define(`ANCHOR',`divert(0)define(`ANCHORIDX',incr(ANCHORIDX))dnl
<TR><TD>$1</TD><TD><A HREF="HTMLNAME`#'AFU`_'ANCHORIDX">$2</A></TD><TD><A HREF="../man/MANPG.html">MANPG</A></TD></TR>
divert(-1)')

105
Ada95/gen/terminal_interface-curses-aux.ads.m4 Normal file
View File

@ -0,0 +1,105 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-aux__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Aux --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2007,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 $
-- Binding Version 01.00
------------------------------------------------------------------------------
include(`Base_Defs')
with System;
with Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;
with Unchecked_Conversion;
package Terminal_Interface.Curses.Aux is
pragma Preelaborate (Terminal_Interface.Curses.Aux);
use type Interfaces.C.int;
subtype C_Int is Interfaces.C.int;
subtype C_Short is Interfaces.C.short;
subtype C_Long_Int is Interfaces.C.long;
subtype C_Size_T is Interfaces.C.size_t;
subtype C_UInt is Interfaces.C.unsigned;
subtype C_ULong is Interfaces.C.unsigned_long;
subtype C_Char_Ptr is Interfaces.C.Strings.chars_ptr;
type C_Void_Ptr is new System.Address;
include(`Chtype_Def')
-- This is how those constants are defined in ncurses. I see them also
-- exactly like this in all ETI implementations I ever tested. So it
-- could be that this is quite general, but please check with your curses.
-- This is critical, because curses sometime mixes boolean returns with
-- returning an error status.
Curses_Ok : constant C_Int := CF_CURSES_OK;
Curses_Err : constant C_Int := CF_CURSES_ERR;
Curses_True : constant C_Int := CF_CURSES_TRUE;
Curses_False : constant C_Int := CF_CURSES_FALSE;
-- Eti_Error: type for error codes returned by the menu and form subsystem
include(`Eti_Defs')
procedure Eti_Exception (Code : Eti_Error);
-- Dispatch the error code and raise the appropriate exception
--
--
-- Some helpers
function Chtype_To_AttrChar is new
Unchecked_Conversion (Source => C_Chtype,
Target => Attributed_Character);
function AttrChar_To_Chtype is new
Unchecked_Conversion (Source => Attributed_Character,
Target => C_Chtype);
function AttrChar_To_AttrType is new
Unchecked_Conversion (Source => Attributed_Character,
Target => C_AttrType);
function AttrType_To_AttrChar is new
Unchecked_Conversion (Source => C_AttrType,
Target => Attributed_Character);
procedure Fill_String (Cp : chars_ptr;
Str : out String);
-- Fill the Str parameter with the string denoted by the chars_ptr
-- C-Style string.
function Fill_String (Cp : chars_ptr) return String;
-- Same but as function.
end Terminal_Interface.Curses.Aux;

238
Ada95/gen/terminal_interface-curses-forms-field_types.ads.m4 Normal file
View File

@ -0,0 +1,238 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-forms-field_user_data__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Forms.Field_Types --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-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.15 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Interfaces.C;
package Terminal_Interface.Curses.Forms.Field_Types is
pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types);
use type Interfaces.C.int;
subtype C_Int is Interfaces.C.int;
-- MANPAGE(`form_fieldtype.3x')
type Field_Type is abstract tagged null record;
-- Abstract base type for all field types. A concrete field type
-- is an extension that adds some data elements describing formats or
-- boundary values for the type and validation routines.
-- For the builtin low-level fieldtypes, the validation routines are
-- already defined by the low-level C library.
-- The builtin types like Alpha or AlphaNumeric etc. are defined in
-- child packages of this package. You may use one of them as example
-- how to create you own child packages for low-level field types that
-- you may have already written in C.
type Field_Type_Access is access all Field_Type'Class;
-- ANCHOR(`set_field_type()',`Set_Type')
procedure Set_Field_Type (Fld : Field;
Fld_Type : Field_Type) is abstract;
-- AKA
-- But: we hide the vararg mechanism of the C interface. You always
-- have to pass a single Field_Type parameter.
-- ---------------------------------------------------------------------
-- MANPAGE(`form_field_validation.3x')
-- ANCHOR(`field_type()',`Get_Type')
function Get_Type (Fld : Field) return Field_Type_Access;
-- AKA
-- ALIAS(`field_arg()')
-- In Ada95 we can combine these. If you try to retrieve the field type
-- that is not defined as extension of the abstract tagged type above,
-- you will raise a Form_Exception.
-- This is not inlined
-- +----------------------------------------------------------------------
-- | Private Part.
-- | Most of this is used by the implementations of the child packages.
-- |
private
type Makearg_Function is access
function (Args : System.Address) return System.Address;
pragma Convention (C, Makearg_Function);
type Copyarg_Function is access
function (Usr : System.Address) return System.Address;
pragma Convention (C, Copyarg_Function);
type Freearg_Function is access
procedure (Usr : System.Address);
pragma Convention (C, Freearg_Function);
type Field_Check_Function is access
function (Fld : Field; Usr : System.Address) return C_Int;
pragma Convention (C, Field_Check_Function);
type Char_Check_Function is access
function (Ch : C_Int; Usr : System.Address) return C_Int;
pragma Convention (C, Char_Check_Function);
type Choice_Function is access
function (Fld : Field; Usr : System.Address) return C_Int;
pragma Convention (C, Choice_Function);
-- +----------------------------------------------------------------------
-- | This must be in sync with the FIELDTYPE structure in form.h
-- |
type Low_Level_Field_Type is
record
Status : Interfaces.C.short;
Ref_Count : Interfaces.C.long;
Left, Right : System.Address;
Makearg : Makearg_Function;
Copyarg : Copyarg_Function;
Freearg : Freearg_Function;
Fcheck : Field_Check_Function;
Ccheck : Char_Check_Function;
Next, Prev : Choice_Function;
end record;
pragma Convention (C, Low_Level_Field_Type);
type C_Field_Type is access all Low_Level_Field_Type;
Null_Field_Type : constant C_Field_Type := null;
-- +----------------------------------------------------------------------
-- | This four low-level fieldtypes are the ones associated with
-- | fieldtypes handled by this binding. Any other low-level fieldtype
-- | will result in a Form_Exception is function Get_Type.
-- |
M_Generic_Type : C_Field_Type := null;
M_Generic_Choice : C_Field_Type := null;
M_Builtin_Router : C_Field_Type := null;
M_Choice_Router : C_Field_Type := null;
-- Two wrapper functions to access those low-level fieldtypes defined
-- in this package.
function C_Builtin_Router return C_Field_Type;
function C_Choice_Router return C_Field_Type;
procedure Wrap_Builtin (Fld : Field;
Typ : Field_Type'Class;
Cft : C_Field_Type := C_Builtin_Router);
-- This procedure has to be called by the Set_Field_Type implementation
-- for builtin low-level fieldtypes to replace it by an Ada95
-- conformant Field_Type object.
-- The parameter Cft must be C_Builtin_Router for regular low-level
-- fieldtypes (like TYP_ALPHA or TYP_ALNUM) and C_Choice_Router for
-- low-level fieldtypes witch choice functions (like TYP_ENUM).
-- Any other value will raise a Form_Exception.
function Make_Arg (Args : System.Address) return System.Address;
pragma Convention (C, Make_Arg);
-- This is the Makearg_Function for the internal low-level types
-- introduced by this binding.
function Copy_Arg (Usr : System.Address) return System.Address;
pragma Convention (C, Copy_Arg);
-- This is the Copyarg_Function for the internal low-level types
-- introduced by this binding.
procedure Free_Arg (Usr : System.Address);
pragma Convention (C, Free_Arg);
-- This is the Freearg_Function for the internal low-level types
-- introduced by this binding.
function Field_Check_Router (Fld : Field;
Usr : System.Address) return C_Int;
pragma Convention (C, Field_Check_Router);
-- This is the Field_Check_Function for the internal low-level types
-- introduced to wrap the low-level types by a Field_Type derived
-- type. It routes the call to the corresponding low-level validation
-- function.
function Char_Check_Router (Ch : C_Int;
Usr : System.Address) return C_Int;
pragma Convention (C, Char_Check_Router);
-- This is the Char_Check_Function for the internal low-level types
-- introduced to wrap the low-level types by a Field_Type derived
-- type. It routes the call to the corresponding low-level validation
-- function.
function Next_Router (Fld : Field;
Usr : System.Address) return C_Int;
pragma Convention (C, Next_Router);
-- This is the Choice_Function for the internal low-level types
-- introduced to wrap the low-level types by a Field_Type derived
-- type. It routes the call to the corresponding low-level next_choice
-- function.
function Prev_Router (Fld : Field;
Usr : System.Address) return C_Int;
pragma Convention (C, Prev_Router);
-- This is the Choice_Function for the internal low-level types
-- introduced to wrap the low-level types by a Field_Type derived
-- type. It routes the call to the corresponding low-level prev_choice
-- function.
-- This is the Argument structure maintained by all low-level field types
-- introduced by this binding.
type Argument is record
Typ : Field_Type_Access; -- the Field_Type creating this record
Usr : System.Address; -- original arg for builtin low-level types
Cft : C_Field_Type; -- the original low-level type
end record;
type Argument_Access is access all Argument;
-- +----------------------------------------------------------------------
-- |
-- | Some Imports of libform routines to deal with low-level fieldtypes.
-- |
function New_Fieldtype (Fcheck : Field_Check_Function;
Ccheck : Char_Check_Function)
return C_Field_Type;
pragma Import (C, New_Fieldtype, "new_fieldtype");
function Set_Fieldtype_Arg (Cft : C_Field_Type;
Mak : Makearg_Function := Make_Arg'Access;
Cop : Copyarg_Function := Copy_Arg'Access;
Fre : Freearg_Function := Free_Arg'Access)
return C_Int;
pragma Import (C, Set_Fieldtype_Arg, "set_fieldtype_arg");
function Set_Fieldtype_Choice (Cft : C_Field_Type;
Next, Prev : Choice_Function)
return C_Int;
pragma Import (C, Set_Fieldtype_Choice, "set_fieldtype_choice");
end Terminal_Interface.Curses.Forms.Field_Types;

70
Ada95/gen/terminal_interface-curses-forms-field_user_data.ads.m4 Normal file
View File

@ -0,0 +1,70 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-forms-field_user_data__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Forms.Field_User_Data --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-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.16 $
-- Binding Version 01.00
------------------------------------------------------------------------------
generic
type User is limited private;
type User_Access is access User;
package Terminal_Interface.Curses.Forms.Field_User_Data is
pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_User_Data);
-- MANPAGE(`form_field_userptr.3x')
-- ANCHOR(`set_field_userptr',`Set_User_Data')
procedure Set_User_Data (Fld : Field;
Data : User_Access);
-- AKA
pragma Inline (Set_User_Data);
-- ANCHOR(`field_userptr',`Get_User_Data')
procedure Get_User_Data (Fld : Field;
Data : out User_Access);
-- AKA
-- ANCHOR(`field_userptr',`Get_User_Data')
function Get_User_Data (Fld : Field) return User_Access;
-- AKA
-- Sama as function
pragma Inline (Get_User_Data);
end Terminal_Interface.Curses.Forms.Field_User_Data;

70
Ada95/gen/terminal_interface-curses-forms-form_user_data.ads.m4 Normal file
View File

@ -0,0 +1,70 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-forms-form_user_data__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Forms.Form_User_Data --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-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.15 $
-- Binding Version 01.00
------------------------------------------------------------------------------
generic
type User is limited private;
type User_Access is access User;
package Terminal_Interface.Curses.Forms.Form_User_Data is
pragma Preelaborate (Terminal_Interface.Curses.Forms.Form_User_Data);
-- MANPAGE(`form_userptr.3x')
-- ANCHOR(`set_form_userptr',`Set_User_Data')
procedure Set_User_Data (Frm : Form;
Data : User_Access);
-- AKA
pragma Inline (Set_User_Data);
-- ANCHOR(`form_userptr',`Get_User_Data')
procedure Get_User_Data (Frm : Form;
Data : out User_Access);
-- AKA
-- ANCHOR(`form_userptr',`Get_User_Data')
function Get_User_Data (Frm : Form) return User_Access;
-- AKA
-- Same as function
pragma Inline (Get_User_Data);
end Terminal_Interface.Curses.Forms.Form_User_Data;

699
Ada95/gen/terminal_interface-curses-forms.ads.m4 Normal file
View File

@ -0,0 +1,699 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-forms__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Form --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2006,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.30 $
-- $Date: 2009/12/26 17:31:35 $
-- Binding Version 01.00
------------------------------------------------------------------------------
include(`Form_Base_Defs')
with System;
with Ada.Characters.Latin_1;
package Terminal_Interface.Curses.Forms is
pragma Preelaborate (Terminal_Interface.Curses.Forms);
include(`Form_Linker_Options')dnl
include(`Linker_Options')
Space : Character renames Ada.Characters.Latin_1.Space;
type Field is private;
type Form is private;
Null_Field : constant Field;
Null_Form : constant Form;
type Field_Justification is (None,
Left,
Center,
Right);
pragma Warnings (Off);
include(`Field_Rep')Dnl
pragma Warnings (On);
function Default_Field_Options return Field_Option_Set;
-- The initial defaults for the field options.
pragma Inline (Default_Field_Options);
pragma Warnings (Off);
include(`Form_Opt_Rep')Dnl
pragma Warnings (On);
function Default_Form_Options return Form_Option_Set;
-- The initial defaults for the form options.
pragma Inline (Default_Form_Options);
type Buffer_Number is new Natural;
type Field_Array is array (Positive range <>) of aliased Field;
pragma Convention (C, Field_Array);
type Field_Array_Access is access Field_Array;
procedure Free (FA : in out Field_Array_Access;
Free_Fields : Boolean := False);
-- Release the memory for an allocated field array
-- If Free_Fields is True, call Delete() for all the fields in
-- the array.
subtype Form_Request_Code is Key_Code range (Key_Max + 1) .. (Key_Max + 57);
-- The prefix F_ stands for "Form Request"
F_Next_Page : constant Form_Request_Code := Key_Max + 1;
F_Previous_Page : constant Form_Request_Code := Key_Max + 2;
F_First_Page : constant Form_Request_Code := Key_Max + 3;
F_Last_Page : constant Form_Request_Code := Key_Max + 4;
F_Next_Field : constant Form_Request_Code := Key_Max + 5;
F_Previous_Field : constant Form_Request_Code := Key_Max + 6;
F_First_Field : constant Form_Request_Code := Key_Max + 7;
F_Last_Field : constant Form_Request_Code := Key_Max + 8;
F_Sorted_Next_Field : constant Form_Request_Code := Key_Max + 9;
F_Sorted_Previous_Field : constant Form_Request_Code := Key_Max + 10;
F_Sorted_First_Field : constant Form_Request_Code := Key_Max + 11;
F_Sorted_Last_Field : constant Form_Request_Code := Key_Max + 12;
F_Left_Field : constant Form_Request_Code := Key_Max + 13;
F_Right_Field : constant Form_Request_Code := Key_Max + 14;
F_Up_Field : constant Form_Request_Code := Key_Max + 15;
F_Down_Field : constant Form_Request_Code := Key_Max + 16;
F_Next_Char : constant Form_Request_Code := Key_Max + 17;
F_Previous_Char : constant Form_Request_Code := Key_Max + 18;
F_Next_Line : constant Form_Request_Code := Key_Max + 19;
F_Previous_Line : constant Form_Request_Code := Key_Max + 20;
F_Next_Word : constant Form_Request_Code := Key_Max + 21;
F_Previous_Word : constant Form_Request_Code := Key_Max + 22;
F_Begin_Field : constant Form_Request_Code := Key_Max + 23;
F_End_Field : constant Form_Request_Code := Key_Max + 24;
F_Begin_Line : constant Form_Request_Code := Key_Max + 25;
F_End_Line : constant Form_Request_Code := Key_Max + 26;
F_Left_Char : constant Form_Request_Code := Key_Max + 27;
F_Right_Char : constant Form_Request_Code := Key_Max + 28;
F_Up_Char : constant Form_Request_Code := Key_Max + 29;
F_Down_Char : constant Form_Request_Code := Key_Max + 30;
F_New_Line : constant Form_Request_Code := Key_Max + 31;
F_Insert_Char : constant Form_Request_Code := Key_Max + 32;
F_Insert_Line : constant Form_Request_Code := Key_Max + 33;
F_Delete_Char : constant Form_Request_Code := Key_Max + 34;
F_Delete_Previous : constant Form_Request_Code := Key_Max + 35;
F_Delete_Line : constant Form_Request_Code := Key_Max + 36;
F_Delete_Word : constant Form_Request_Code := Key_Max + 37;
F_Clear_EOL : constant Form_Request_Code := Key_Max + 38;
F_Clear_EOF : constant Form_Request_Code := Key_Max + 39;
F_Clear_Field : constant Form_Request_Code := Key_Max + 40;
F_Overlay_Mode : constant Form_Request_Code := Key_Max + 41;
F_Insert_Mode : constant Form_Request_Code := Key_Max + 42;
-- Vertical Scrolling
F_ScrollForward_Line : constant Form_Request_Code := Key_Max + 43;
F_ScrollBackward_Line : constant Form_Request_Code := Key_Max + 44;
F_ScrollForward_Page : constant Form_Request_Code := Key_Max + 45;
F_ScrollBackward_Page : constant Form_Request_Code := Key_Max + 46;
F_ScrollForward_HalfPage : constant Form_Request_Code := Key_Max + 47;
F_ScrollBackward_HalfPage : constant Form_Request_Code := Key_Max + 48;
-- Horizontal Scrolling
F_HScrollForward_Char : constant Form_Request_Code := Key_Max + 49;
F_HScrollBackward_Char : constant Form_Request_Code := Key_Max + 50;
F_HScrollForward_Line : constant Form_Request_Code := Key_Max + 51;
F_HScrollBackward_Line : constant Form_Request_Code := Key_Max + 52;
F_HScrollForward_HalfLine : constant Form_Request_Code := Key_Max + 53;
F_HScrollBackward_HalfLine : constant Form_Request_Code := Key_Max + 54;
F_Validate_Field : constant Form_Request_Code := Key_Max + 55;
F_Next_Choice : constant Form_Request_Code := Key_Max + 56;
F_Previous_Choice : constant Form_Request_Code := Key_Max + 57;
-- For those who like the old 'C' style request names
REQ_NEXT_PAGE : Form_Request_Code renames F_Next_Page;
REQ_PREV_PAGE : Form_Request_Code renames F_Previous_Page;
REQ_FIRST_PAGE : Form_Request_Code renames F_First_Page;
REQ_LAST_PAGE : Form_Request_Code renames F_Last_Page;
REQ_NEXT_FIELD : Form_Request_Code renames F_Next_Field;
REQ_PREV_FIELD : Form_Request_Code renames F_Previous_Field;
REQ_FIRST_FIELD : Form_Request_Code renames F_First_Field;
REQ_LAST_FIELD : Form_Request_Code renames F_Last_Field;
REQ_SNEXT_FIELD : Form_Request_Code renames F_Sorted_Next_Field;
REQ_SPREV_FIELD : Form_Request_Code renames F_Sorted_Previous_Field;
REQ_SFIRST_FIELD : Form_Request_Code renames F_Sorted_First_Field;
REQ_SLAST_FIELD : Form_Request_Code renames F_Sorted_Last_Field;
REQ_LEFT_FIELD : Form_Request_Code renames F_Left_Field;
REQ_RIGHT_FIELD : Form_Request_Code renames F_Right_Field;
REQ_UP_FIELD : Form_Request_Code renames F_Up_Field;
REQ_DOWN_FIELD : Form_Request_Code renames F_Down_Field;
REQ_NEXT_CHAR : Form_Request_Code renames F_Next_Char;
REQ_PREV_CHAR : Form_Request_Code renames F_Previous_Char;
REQ_NEXT_LINE : Form_Request_Code renames F_Next_Line;
REQ_PREV_LINE : Form_Request_Code renames F_Previous_Line;
REQ_NEXT_WORD : Form_Request_Code renames F_Next_Word;
REQ_PREV_WORD : Form_Request_Code renames F_Previous_Word;
REQ_BEG_FIELD : Form_Request_Code renames F_Begin_Field;
REQ_END_FIELD : Form_Request_Code renames F_End_Field;
REQ_BEG_LINE : Form_Request_Code renames F_Begin_Line;
REQ_END_LINE : Form_Request_Code renames F_End_Line;
REQ_LEFT_CHAR : Form_Request_Code renames F_Left_Char;
REQ_RIGHT_CHAR : Form_Request_Code renames F_Right_Char;
REQ_UP_CHAR : Form_Request_Code renames F_Up_Char;
REQ_DOWN_CHAR : Form_Request_Code renames F_Down_Char;
REQ_NEW_LINE : Form_Request_Code renames F_New_Line;
REQ_INS_CHAR : Form_Request_Code renames F_Insert_Char;
REQ_INS_LINE : Form_Request_Code renames F_Insert_Line;
REQ_DEL_CHAR : Form_Request_Code renames F_Delete_Char;
REQ_DEL_PREV : Form_Request_Code renames F_Delete_Previous;
REQ_DEL_LINE : Form_Request_Code renames F_Delete_Line;
REQ_DEL_WORD : Form_Request_Code renames F_Delete_Word;
REQ_CLR_EOL : Form_Request_Code renames F_Clear_EOL;
REQ_CLR_EOF : Form_Request_Code renames F_Clear_EOF;
REQ_CLR_FIELD : Form_Request_Code renames F_Clear_Field;
REQ_OVL_MODE : Form_Request_Code renames F_Overlay_Mode;
REQ_INS_MODE : Form_Request_Code renames F_Insert_Mode;
REQ_SCR_FLINE : Form_Request_Code renames F_ScrollForward_Line;
REQ_SCR_BLINE : Form_Request_Code renames F_ScrollBackward_Line;
REQ_SCR_FPAGE : Form_Request_Code renames F_ScrollForward_Page;
REQ_SCR_BPAGE : Form_Request_Code renames F_ScrollBackward_Page;
REQ_SCR_FHPAGE : Form_Request_Code renames F_ScrollForward_HalfPage;
REQ_SCR_BHPAGE : Form_Request_Code renames F_ScrollBackward_HalfPage;
REQ_SCR_FCHAR : Form_Request_Code renames F_HScrollForward_Char;
REQ_SCR_BCHAR : Form_Request_Code renames F_HScrollBackward_Char;
REQ_SCR_HFLINE : Form_Request_Code renames F_HScrollForward_Line;
REQ_SCR_HBLINE : Form_Request_Code renames F_HScrollBackward_Line;
REQ_SCR_HFHALF : Form_Request_Code renames F_HScrollForward_HalfLine;
REQ_SCR_HBHALF : Form_Request_Code renames F_HScrollBackward_HalfLine;
REQ_VALIDATION : Form_Request_Code renames F_Validate_Field;
REQ_NEXT_CHOICE : Form_Request_Code renames F_Next_Choice;
REQ_PREV_CHOICE : Form_Request_Code renames F_Previous_Choice;
procedure Request_Name (Key : Form_Request_Code;
Name : out String);
function Request_Name (Key : Form_Request_Code) return String;
-- Same as function
pragma Inline (Request_Name);
------------------
-- Exceptions --
------------------
Form_Exception : exception;
-- MANPAGE(`form_field_new.3x')
-- ANCHOR(`new_field()',`Create')
function Create (Height : Line_Count;
Width : Column_Count;
Top : Line_Position;
Left : Column_Position;
Off_Screen : Natural := 0;
More_Buffers : Buffer_Number := Buffer_Number'First)
return Field;
-- AKA
-- An overloaded Create is defined later. Pragma Inline appears there.
-- ANCHOR(`new_field()',`New_Field')
function New_Field (Height : Line_Count;
Width : Column_Count;
Top : Line_Position;
Left : Column_Position;
Off_Screen : Natural := 0;
More_Buffers : Buffer_Number := Buffer_Number'First)
return Field renames Create;
-- AKA
pragma Inline (New_Field);
-- ANCHOR(`free_field()',`Delete')
procedure Delete (Fld : in out Field);
-- AKA
-- Reset Fld to Null_Field
-- An overloaded Delete is defined later. Pragma Inline appears there.
-- ANCHOR(`dup_field()',`Duplicate')
function Duplicate (Fld : Field;
Top : Line_Position;
Left : Column_Position) return Field;
-- AKA
pragma Inline (Duplicate);
-- ANCHOR(`link_field()',`Link')
function Link (Fld : Field;
Top : Line_Position;
Left : Column_Position) return Field;
-- AKA
pragma Inline (Link);
-- MANPAGE(`form_field_just.3x')
-- ANCHOR(`set_field_just()',`Set_Justification')
procedure Set_Justification (Fld : Field;
Just : Field_Justification := None);
-- AKA
pragma Inline (Set_Justification);
-- ANCHOR(`field_just()',`Get_Justification')
function Get_Justification (Fld : Field) return Field_Justification;
-- AKA
pragma Inline (Get_Justification);
-- MANPAGE(`form_field_buffer.3x')
-- ANCHOR(`set_field_buffer()',`Set_Buffer')
procedure Set_Buffer
(Fld : Field;
Buffer : Buffer_Number := Buffer_Number'First;
Str : String);
-- AKA
-- Not inlined
-- ANCHOR(`field_buffer()',`Get_Buffer')
procedure Get_Buffer
(Fld : Field;
Buffer : Buffer_Number := Buffer_Number'First;
Str : out String);
-- AKA
function Get_Buffer
(Fld : Field;
Buffer : Buffer_Number := Buffer_Number'First) return String;
-- AKA
-- Same but as function
pragma Inline (Get_Buffer);
-- ANCHOR(`set_field_status()',`Set_Status')
procedure Set_Status (Fld : Field;
Status : Boolean := True);
-- AKA
pragma Inline (Set_Status);
-- ANCHOR(`field_status()',`Changed')
function Changed (Fld : Field) return Boolean;
-- AKA
pragma Inline (Changed);
-- ANCHOR(`set_field_max()',`Set_Maximum_Size')
procedure Set_Maximum_Size (Fld : Field;
Max : Natural := 0);
-- AKA
pragma Inline (Set_Maximum_Size);
-- MANPAGE(`form_field_opts.3x')
-- ANCHOR(`set_field_opts()',`Set_Options')
procedure Set_Options (Fld : Field;
Options : Field_Option_Set);
-- AKA
-- An overloaded version is defined later. Pragma Inline appears there
-- ANCHOR(`field_opts_on()',`Switch_Options')
procedure Switch_Options (Fld : Field;
Options : Field_Option_Set;
On : Boolean := True);
-- AKA
-- ALIAS(`field_opts_off()')
-- An overloaded version is defined later. Pragma Inline appears there
-- ANCHOR(`field_opts()',`Get_Options')
procedure Get_Options (Fld : Field;
Options : out Field_Option_Set);
-- AKA
-- ANCHOR(`field_opts()',`Get_Options')
function Get_Options (Fld : Field := Null_Field)
return Field_Option_Set;
-- AKA
-- An overloaded version is defined later. Pragma Inline appears there
-- MANPAGE(`form_field_attributes.3x')
-- ANCHOR(`set_field_fore()',`Set_Foreground')
procedure Set_Foreground
(Fld : Field;
Fore : Character_Attribute_Set := Normal_Video;
Color : Color_Pair := Color_Pair'First);
-- AKA
pragma Inline (Set_Foreground);
-- ANCHOR(`field_fore()',`Foreground')
procedure Foreground (Fld : Field;
Fore : out Character_Attribute_Set);
-- AKA
-- ANCHOR(`field_fore()',`Foreground')
procedure Foreground (Fld : Field;
Fore : out Character_Attribute_Set;
Color : out Color_Pair);
-- AKA
pragma Inline (Foreground);
-- ANCHOR(`set_field_back()',`Set_Background')
procedure Set_Background
(Fld : Field;
Back : Character_Attribute_Set := Normal_Video;
Color : Color_Pair := Color_Pair'First);
-- AKA
pragma Inline (Set_Background);
-- ANCHOR(`field_back()',`Background')
procedure Background (Fld : Field;
Back : out Character_Attribute_Set);
-- AKA
-- ANCHOR(`field_back()',`Background')
procedure Background (Fld : Field;
Back : out Character_Attribute_Set;
Color : out Color_Pair);
-- AKA
pragma Inline (Background);
-- ANCHOR(`set_field_pad()',`Set_Pad_Character')
procedure Set_Pad_Character (Fld : Field;
Pad : Character := Space);
-- AKA
pragma Inline (Set_Pad_Character);
-- ANCHOR(`field_pad()',`Pad_Character')
procedure Pad_Character (Fld : Field;
Pad : out Character);
-- AKA
pragma Inline (Pad_Character);
-- MANPAGE(`form_field_info.3x')
-- ANCHOR(`field_info()',`Info')
procedure Info (Fld : Field;
Lines : out Line_Count;
Columns : out Column_Count;
First_Row : out Line_Position;
First_Column : out Column_Position;
Off_Screen : out Natural;
Additional_Buffers : out Buffer_Number);
-- AKA
pragma Inline (Info);
-- ANCHOR(`dynamic_field_info()',`Dynamic_Info')
procedure Dynamic_Info (Fld : Field;
Lines : out Line_Count;
Columns : out Column_Count;
Max : out Natural);
-- AKA
pragma Inline (Dynamic_Info);
-- MANPAGE(`form_win.3x')
-- ANCHOR(`set_form_win()',`Set_Window')
procedure Set_Window (Frm : Form;
Win : Window);
-- AKA
pragma Inline (Set_Window);
-- ANCHOR(`form_win()',`Get_Window')
function Get_Window (Frm : Form) return Window;
-- AKA
pragma Inline (Get_Window);
-- ANCHOR(`set_form_sub()',`Set_Sub_Window')
procedure Set_Sub_Window (Frm : Form;
Win : Window);
-- AKA
pragma Inline (Set_Sub_Window);
-- ANCHOR(`form_sub()',`Get_Sub_Window')
function Get_Sub_Window (Frm : Form) return Window;
-- AKA
pragma Inline (Get_Sub_Window);
-- ANCHOR(`scale_form()',`Scale')
procedure Scale (Frm : Form;
Lines : out Line_Count;
Columns : out Column_Count);
-- AKA
pragma Inline (Scale);
-- MANPAGE(`form_hook.3x')
type Form_Hook_Function is access procedure (Frm : Form);
pragma Convention (C, Form_Hook_Function);
-- ANCHOR(`set_field_init()',`Set_Field_Init_Hook')
procedure Set_Field_Init_Hook (Frm : Form;
Proc : Form_Hook_Function);
-- AKA
pragma Inline (Set_Field_Init_Hook);
-- ANCHOR(`set_field_term()',`Set_Field_Term_Hook')
procedure Set_Field_Term_Hook (Frm : Form;
Proc : Form_Hook_Function);
-- AKA
pragma Inline (Set_Field_Term_Hook);
-- ANCHOR(`set_form_init()',`Set_Form_Init_Hook')
procedure Set_Form_Init_Hook (Frm : Form;
Proc : Form_Hook_Function);
-- AKA
pragma Inline (Set_Form_Init_Hook);
-- ANCHOR(`set_form_term()',`Set_Form_Term_Hook')
procedure Set_Form_Term_Hook (Frm : Form;
Proc : Form_Hook_Function);
-- AKA
pragma Inline (Set_Form_Term_Hook);
-- ANCHOR(`field_init()',`Get_Field_Init_Hook')
function Get_Field_Init_Hook (Frm : Form) return Form_Hook_Function;
-- AKA
pragma Import (C, Get_Field_Init_Hook, "field_init");
-- ANCHOR(`field_term()',`Get_Field_Term_Hook')
function Get_Field_Term_Hook (Frm : Form) return Form_Hook_Function;
-- AKA
pragma Import (C, Get_Field_Term_Hook, "field_term");
-- ANCHOR(`form_init()',`Get_Form_Init_Hook')
function Get_Form_Init_Hook (Frm : Form) return Form_Hook_Function;
-- AKA
pragma Import (C, Get_Form_Init_Hook, "form_init");
-- ANCHOR(`form_term()',`Get_Form_Term_Hook')
function Get_Form_Term_Hook (Frm : Form) return Form_Hook_Function;
-- AKA
pragma Import (C, Get_Form_Term_Hook, "form_term");
-- MANPAGE(`form_field.3x')
-- ANCHOR(`set_form_fields()',`Redefine')
procedure Redefine (Frm : Form;
Flds : Field_Array_Access);
-- AKA
pragma Inline (Redefine);
-- ANCHOR(`set_form_fields()',`Set_Fields')
procedure Set_Fields (Frm : Form;
Flds : Field_Array_Access) renames Redefine;
-- AKA
-- pragma Inline (Set_Fields);
-- ANCHOR(`form_fields()',`Fields')
function Fields (Frm : Form;
Index : Positive) return Field;
-- AKA
pragma Inline (Fields);
-- ANCHOR(`field_count()',`Field_Count')
function Field_Count (Frm : Form) return Natural;
-- AKA
pragma Inline (Field_Count);
-- ANCHOR(`move_field()',`Move')
procedure Move (Fld : Field;
Line : Line_Position;
Column : Column_Position);
-- AKA
pragma Inline (Move);
-- MANPAGE(`form_new.3x')
-- ANCHOR(`new_form()',`Create')
function Create (Fields : Field_Array_Access) return Form;
-- AKA
pragma Inline (Create);
-- ANCHOR(`new_form()',`New_Form')
function New_Form (Fields : Field_Array_Access) return Form
renames Create;
-- AKA
-- pragma Inline (New_Form);
-- ANCHOR(`free_form()',`Delete')
procedure Delete (Frm : in out Form);
-- AKA
-- Reset Frm to Null_Form
pragma Inline (Delete);
-- MANPAGE(`form_opts.3x')
-- ANCHOR(`set_form_opts()',`Set_Options')
procedure Set_Options (Frm : Form;
Options : Form_Option_Set);
-- AKA
pragma Inline (Set_Options);
-- ANCHOR(`form_opts_on()',`Switch_Options')
procedure Switch_Options (Frm : Form;
Options : Form_Option_Set;
On : Boolean := True);
-- AKA
-- ALIAS(`form_opts_off()')
pragma Inline (Switch_Options);
-- ANCHOR(`form_opts()',`Get_Options')
procedure Get_Options (Frm : Form;
Options : out Form_Option_Set);
-- AKA
-- ANCHOR(`form_opts()',`Get_Options')
function Get_Options (Frm : Form := Null_Form) return Form_Option_Set;
-- AKA
pragma Inline (Get_Options);
-- MANPAGE(`form_post.3x')
-- ANCHOR(`post_form()',`Post')
procedure Post (Frm : Form;
Post : Boolean := True);
-- AKA
-- ALIAS(`unpost_form()')
pragma Inline (Post);
-- MANPAGE(`form_cursor.3x')
-- ANCHOR(`pos_form_cursor()',`Position_Cursor')
procedure Position_Cursor (Frm : Form);
-- AKA
pragma Inline (Position_Cursor);
-- MANPAGE(`form_data.3x')
-- ANCHOR(`data_ahead()',`Data_Ahead')
function Data_Ahead (Frm : Form) return Boolean;
-- AKA
pragma Inline (Data_Ahead);
-- ANCHOR(`data_behind()',`Data_Behind')
function Data_Behind (Frm : Form) return Boolean;
-- AKA
pragma Inline (Data_Behind);
-- MANPAGE(`form_driver.3x')
type Driver_Result is (Form_Ok,
Request_Denied,
Unknown_Request,
Invalid_Field);
-- ANCHOR(`form_driver()',`Driver')
function Driver (Frm : Form;
Key : Key_Code) return Driver_Result;
-- AKA
-- Driver not inlined
-- MANPAGE(`form_page.3x')
type Page_Number is new Natural;
-- ANCHOR(`set_current_field()',`Set_Current')
procedure Set_Current (Frm : Form;
Fld : Field);
-- AKA
pragma Inline (Set_Current);
-- ANCHOR(`current_field()',`Current')
function Current (Frm : Form) return Field;
-- AKA
pragma Inline (Current);
-- ANCHOR(`set_form_page()',`Set_Page')
procedure Set_Page (Frm : Form;
Page : Page_Number := Page_Number'First);
-- AKA
pragma Inline (Set_Page);
-- ANCHOR(`form_page()',`Page')
function Page (Frm : Form) return Page_Number;
-- AKA
pragma Inline (Page);
-- ANCHOR(`field_index()',`Get_Index')
function Get_Index (Fld : Field) return Positive;
-- AKA
-- Please note that in this binding we start the numbering of fields
-- with 1. So this is number is one more than you get from the low
-- level call.
pragma Inline (Get_Index);
-- MANPAGE(`form_new_page.3x')
-- ANCHOR(`set_new_page()',`Set_New_Page')
procedure Set_New_Page (Fld : Field;
New_Page : Boolean := True);
-- AKA
pragma Inline (Set_New_Page);
-- ANCHOR(`new_page()',`Is_New_Page')
function Is_New_Page (Fld : Field) return Boolean;
-- AKA
pragma Inline (Is_New_Page);
-- MANPAGE(`form_requestname.3x')
-- Not Implemented: form_request_name, form_request_by_name
------------------------------------------------------------------------------
private
type Field is new System.Storage_Elements.Integer_Address;
type Form is new System.Storage_Elements.Integer_Address;
Null_Field : constant Field := 0;
Null_Form : constant Form := 0;
end Terminal_Interface.Curses.Forms;

75
Ada95/gen/terminal_interface-curses-menus-item_user_data.ads.m4 Normal file
View File

@ -0,0 +1,75 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-menus-item_user_data__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Menus.Item_User_Data --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2006,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:31:35 $
-- Binding Version 01.00
------------------------------------------------------------------------------
generic
type User is limited private;
type User_Access is access User;
package Terminal_Interface.Curses.Menus.Item_User_Data is
pragma Preelaborate (Terminal_Interface.Curses.Menus.Item_User_Data);
-- The binding uses the same user pointer for menu items
-- as the low level C implementation. So you can safely
-- read or write the user pointer also with the C routines
--
-- MANPAGE(`mitem_userptr.3x')
-- ANCHOR(`set_item_userptr',`Set_User_Data')
procedure Set_User_Data (Itm : Item;
Data : User_Access);
-- AKA
pragma Inline (Set_User_Data);
-- ANCHOR(`item_userptr',`Get_User_Data')
procedure Get_User_Data (Itm : Item;
Data : out User_Access);
-- AKA
-- ANCHOR(`item_userptr',`Get_User_Data')
function Get_User_Data (Itm : Item) return User_Access;
-- AKA
-- Same as function
pragma Inline (Get_User_Data);
end Terminal_Interface.Curses.Menus.Item_User_Data;

70
Ada95/gen/terminal_interface-curses-menus-menu_user_data.ads.m4 Normal file
View File

@ -0,0 +1,70 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-menus-menu_user_data__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Menus.Menu_User_Data --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-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.15 $
-- Binding Version 01.00
------------------------------------------------------------------------------
generic
type User is limited private;
type User_Access is access User;
package Terminal_Interface.Curses.Menus.Menu_User_Data is
pragma Preelaborate (Terminal_Interface.Curses.Menus.Menu_User_Data);
-- MANPAGE(`menu_userptr.3x')
-- ANCHOR(`set_menu_userptr',`Set_User_Data')
procedure Set_User_Data (Men : Menu;
Data : User_Access);
-- AKA
pragma Inline (Set_User_Data);
-- ANCHOR(`menu_userptr',`Get_User_Data')
procedure Get_User_Data (Men : Menu;
Data : out User_Access);
-- AKA
-- ANCHOR(`menu_userptr',`Get_User_Data')
function Get_User_Data (Men : Menu) return User_Access;
-- AKA
-- Same as function
pragma Inline (Get_User_Data);
end Terminal_Interface.Curses.Menus.Menu_User_Data;

604
Ada95/gen/terminal_interface-curses-menus.ads.m4 Normal file
View File

@ -0,0 +1,604 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-menus__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Menu --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2007,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.28 $
-- $Date: 2009/12/26 18:35:22 $
-- Binding Version 01.00
------------------------------------------------------------------------------
include(`Menu_Base_Defs')
with System;
with Ada.Characters.Latin_1;
package Terminal_Interface.Curses.Menus is
pragma Preelaborate (Terminal_Interface.Curses.Menus);
include(`Menu_Linker_Options')dnl
include(`Linker_Options')
Space : Character renames Ada.Characters.Latin_1.Space;
type Item is private;
type Menu is private;
---------------------------
-- Interface constants --
---------------------------
Null_Item : constant Item;
Null_Menu : constant Menu;
subtype Menu_Request_Code is Key_Code
range (Key_Max + 1) .. (Key_Max + 17);
-- The prefix M_ stands for "Menu Request"
M_Left_Item : constant Menu_Request_Code := Key_Max + 1;
M_Right_Item : constant Menu_Request_Code := Key_Max + 2;
M_Up_Item : constant Menu_Request_Code := Key_Max + 3;
M_Down_Item : constant Menu_Request_Code := Key_Max + 4;
M_ScrollUp_Line : constant Menu_Request_Code := Key_Max + 5;
M_ScrollDown_Line : constant Menu_Request_Code := Key_Max + 6;
M_ScrollDown_Page : constant Menu_Request_Code := Key_Max + 7;
M_ScrollUp_Page : constant Menu_Request_Code := Key_Max + 8;
M_First_Item : constant Menu_Request_Code := Key_Max + 9;
M_Last_Item : constant Menu_Request_Code := Key_Max + 10;
M_Next_Item : constant Menu_Request_Code := Key_Max + 11;
M_Previous_Item : constant Menu_Request_Code := Key_Max + 12;
M_Toggle_Item : constant Menu_Request_Code := Key_Max + 13;
M_Clear_Pattern : constant Menu_Request_Code := Key_Max + 14;
M_Back_Pattern : constant Menu_Request_Code := Key_Max + 15;
M_Next_Match : constant Menu_Request_Code := Key_Max + 16;
M_Previous_Match : constant Menu_Request_Code := Key_Max + 17;
-- For those who like the old 'C' names for the request codes
REQ_LEFT_ITEM : Menu_Request_Code renames M_Left_Item;
REQ_RIGHT_ITEM : Menu_Request_Code renames M_Right_Item;
REQ_UP_ITEM : Menu_Request_Code renames M_Up_Item;
REQ_DOWN_ITEM : Menu_Request_Code renames M_Down_Item;
REQ_SCR_ULINE : Menu_Request_Code renames M_ScrollUp_Line;
REQ_SCR_DLINE : Menu_Request_Code renames M_ScrollDown_Line;
REQ_SCR_DPAGE : Menu_Request_Code renames M_ScrollDown_Page;
REQ_SCR_UPAGE : Menu_Request_Code renames M_ScrollUp_Page;
REQ_FIRST_ITEM : Menu_Request_Code renames M_First_Item;
REQ_LAST_ITEM : Menu_Request_Code renames M_Last_Item;
REQ_NEXT_ITEM : Menu_Request_Code renames M_Next_Item;
REQ_PREV_ITEM : Menu_Request_Code renames M_Previous_Item;
REQ_TOGGLE_ITEM : Menu_Request_Code renames M_Toggle_Item;
REQ_CLEAR_PATTERN : Menu_Request_Code renames M_Clear_Pattern;
REQ_BACK_PATTERN : Menu_Request_Code renames M_Back_Pattern;
REQ_NEXT_MATCH : Menu_Request_Code renames M_Next_Match;
REQ_PREV_MATCH : Menu_Request_Code renames M_Previous_Match;
procedure Request_Name (Key : Menu_Request_Code;
Name : out String);
function Request_Name (Key : Menu_Request_Code) return String;
-- Same as function
------------------
-- Exceptions --
------------------
Menu_Exception : exception;
--
-- Menu options
--
pragma Warnings (Off);
include(`Menu_Opt_Rep')dnl
pragma Warnings (On);
function Default_Menu_Options return Menu_Option_Set;
-- Initial default options for a menu.
pragma Inline (Default_Menu_Options);
--
-- Item options
--
pragma Warnings (Off);
include(`Item_Rep')dnl
pragma Warnings (On);
function Default_Item_Options return Item_Option_Set;
-- Initial default options for an item.
pragma Inline (Default_Item_Options);
--
-- Item Array
--
type Item_Array is array (Positive range <>) of aliased Item;
pragma Convention (C, Item_Array);
type Item_Array_Access is access Item_Array;
procedure Free (IA : in out Item_Array_Access;
Free_Items : Boolean := False);
-- Release the memory for an allocated item array
-- If Free_Items is True, call Delete() for all the items in
-- the array.
-- MANPAGE(`mitem_new.3x')
-- ANCHOR(`new_item()',`Create')
function Create (Name : String;
Description : String := "") return Item;
-- AKA
-- Not inlined.
-- ANCHOR(`new_item()',`New_Item')
function New_Item (Name : String;
Description : String := "") return Item
renames Create;
-- AKA
-- ANCHOR(`free_item()',`Delete')
procedure Delete (Itm : in out Item);
-- AKA
-- Resets Itm to Null_Item
-- MANPAGE(`mitem_value.3x')
-- ANCHOR(`set_item_value()',`Set_Value')
procedure Set_Value (Itm : Item;
Value : Boolean := True);
-- AKA
pragma Inline (Set_Value);
-- ANCHOR(`item_value()',`Value')
function Value (Itm : Item) return Boolean;
-- AKA
pragma Inline (Value);
-- MANPAGE(`mitem_visible.3x')
-- ANCHOR(`item_visible()',`Visible')
function Visible (Itm : Item) return Boolean;
-- AKA
pragma Inline (Visible);
-- MANPAGE(`mitem_opts.3x')
-- ANCHOR(`set_item_opts()',`Set_Options')
procedure Set_Options (Itm : Item;
Options : Item_Option_Set);
-- AKA
-- An overloaded Set_Options is defined later. Pragma Inline appears there
-- ANCHOR(`item_opts_on()',`Switch_Options')
procedure Switch_Options (Itm : Item;
Options : Item_Option_Set;
On : Boolean := True);
-- AKA
-- ALIAS(`item_opts_off()')
-- An overloaded Switch_Options is defined later.
-- Pragma Inline appears there
-- ANCHOR(`item_opts()',`Get_Options')
procedure Get_Options (Itm : Item;
Options : out Item_Option_Set);
-- AKA
-- ANCHOR(`item_opts()',`Get_Options')
function Get_Options (Itm : Item := Null_Item) return Item_Option_Set;
-- AKA
-- An overloaded Get_Options is defined later. Pragma Inline appears there
-- MANPAGE(`mitem_name.3x')
-- ANCHOR(`item_name()',`Name')
procedure Name (Itm : Item;
Name : out String);
-- AKA
function Name (Itm : Item) return String;
-- AKA
-- Implemented as function
pragma Inline (Name);
-- ANCHOR(`item_description();',`Description')
procedure Description (Itm : Item;
Description : out String);
-- AKA
function Description (Itm : Item) return String;
-- AKA
-- Implemented as function
pragma Inline (Description);
-- MANPAGE(`mitem_current.3x')
-- ANCHOR(`set_current_item()',`Set_Current')
procedure Set_Current (Men : Menu;
Itm : Item);
-- AKA
pragma Inline (Set_Current);
-- ANCHOR(`current_item()',`Current')
function Current (Men : Menu) return Item;
-- AKA
pragma Inline (Current);
-- ANCHOR(`set_top_row()',`Set_Top_Row')
procedure Set_Top_Row (Men : Menu;
Line : Line_Position);
-- AKA
pragma Inline (Set_Top_Row);
-- ANCHOR(`top_row()',`Top_Row')
function Top_Row (Men : Menu) return Line_Position;
-- AKA
pragma Inline (Top_Row);
-- ANCHOR(`item_index()',`Get_Index')
function Get_Index (Itm : Item) return Positive;
-- AKA
-- Please note that in this binding we start the numbering of items
-- with 1. So this is number is one more than you get from the low
-- level call.
pragma Inline (Get_Index);
-- MANPAGE(`menu_post.3x')
-- ANCHOR(`post_menu()',`Post')
procedure Post (Men : Menu;
Post : Boolean := True);
-- AKA
-- ALIAS(`unpost_menu()')
pragma Inline (Post);
-- MANPAGE(`menu_opts.3x')
-- ANCHOR(`set_menu_opts()',`Set_Options')
procedure Set_Options (Men : Menu;
Options : Menu_Option_Set);
-- AKA
pragma Inline (Set_Options);
-- ANCHOR(`menu_opts_on()',`Switch_Options')
procedure Switch_Options (Men : Menu;
Options : Menu_Option_Set;
On : Boolean := True);
-- AKA
-- ALIAS(`menu_opts_off()')
pragma Inline (Switch_Options);
-- ANCHOR(`menu_opts()',`Get_Options')
procedure Get_Options (Men : Menu;
Options : out Menu_Option_Set);
-- AKA
-- ANCHOR(`menu_opts()',`Get_Options')
function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set;
-- AKA
pragma Inline (Get_Options);
-- MANPAGE(`menu_win.3x')
-- ANCHOR(`set_menu_win()',`Set_Window')
procedure Set_Window (Men : Menu;
Win : Window);
-- AKA
pragma Inline (Set_Window);
-- ANCHOR(`menu_win()',`Get_Window')
function Get_Window (Men : Menu) return Window;
-- AKA
pragma Inline (Get_Window);
-- ANCHOR(`set_menu_sub()',`Set_Sub_Window')
procedure Set_Sub_Window (Men : Menu;
Win : Window);
-- AKA
pragma Inline (Set_Sub_Window);
-- ANCHOR(`menu_sub()',`Get_Sub_Window')
function Get_Sub_Window (Men : Menu) return Window;
-- AKA
pragma Inline (Get_Sub_Window);
-- ANCHOR(`scale_menu()',`Scale')
procedure Scale (Men : Menu;
Lines : out Line_Count;
Columns : out Column_Count);
-- AKA
pragma Inline (Scale);
-- MANPAGE(`menu_cursor.3x')
-- ANCHOR(`pos_menu_cursor()',`Position_Cursor')
procedure Position_Cursor (Men : Menu);
-- AKA
pragma Inline (Position_Cursor);
-- MANPAGE(`menu_mark.3x')
-- ANCHOR(`set_menu_mark()',`Set_Mark')
procedure Set_Mark (Men : Menu;
Mark : String);
-- AKA
pragma Inline (Set_Mark);
-- ANCHOR(`menu_mark()',`Mark')
procedure Mark (Men : Menu;
Mark : out String);
-- AKA
function Mark (Men : Menu) return String;
-- AKA
-- Implemented as function
pragma Inline (Mark);
-- MANPAGE(`menu_attributes.3x')
-- ANCHOR(`set_menu_fore()',`Set_Foreground')
procedure Set_Foreground
(Men : Menu;
Fore : Character_Attribute_Set := Normal_Video;
Color : Color_Pair := Color_Pair'First);
-- AKA
pragma Inline (Set_Foreground);
-- ANCHOR(`menu_fore()',`Foreground')
procedure Foreground (Men : Menu;
Fore : out Character_Attribute_Set);
-- AKA
-- ANCHOR(`menu_fore()',`Foreground')
procedure Foreground (Men : Menu;
Fore : out Character_Attribute_Set;
Color : out Color_Pair);
-- AKA
pragma Inline (Foreground);
-- ANCHOR(`set_menu_back()',`Set_Background')
procedure Set_Background
(Men : Menu;
Back : Character_Attribute_Set := Normal_Video;
Color : Color_Pair := Color_Pair'First);
-- AKA
pragma Inline (Set_Background);
-- ANCHOR(`menu_back()',`Background')
procedure Background (Men : Menu;
Back : out Character_Attribute_Set);
-- AKA
-- ANCHOR(`menu_back()',`Background')
procedure Background (Men : Menu;
Back : out Character_Attribute_Set;
Color : out Color_Pair);
-- AKA
pragma Inline (Background);
-- ANCHOR(`set_menu_grey()',`Set_Grey')
procedure Set_Grey
(Men : Menu;
Grey : Character_Attribute_Set := Normal_Video;
Color : Color_Pair := Color_Pair'First);
-- AKA
pragma Inline (Set_Grey);
-- ANCHOR(`menu_grey()',`Grey')
procedure Grey (Men : Menu;
Grey : out Character_Attribute_Set);
-- AKA
-- ANCHOR(`menu_grey()',`Grey')
procedure Grey
(Men : Menu;
Grey : out Character_Attribute_Set;
Color : out Color_Pair);
-- AKA
pragma Inline (Grey);
-- ANCHOR(`set_menu_pad()',`Set_Pad_Character')
procedure Set_Pad_Character (Men : Menu;
Pad : Character := Space);
-- AKA
pragma Inline (Set_Pad_Character);
-- ANCHOR(`menu_pad()',`Pad_Character')
procedure Pad_Character (Men : Menu;
Pad : out Character);
-- AKA
pragma Inline (Pad_Character);
-- MANPAGE(`menu_spacing.3x')
-- ANCHOR(`set_menu_spacing()',`Set_Spacing')
procedure Set_Spacing (Men : Menu;
Descr : Column_Position := 0;
Row : Line_Position := 0;
Col : Column_Position := 0);
-- AKA
pragma Inline (Set_Spacing);
-- ANCHOR(`menu_spacing()',`Spacing')
procedure Spacing (Men : Menu;
Descr : out Column_Position;
Row : out Line_Position;
Col : out Column_Position);
-- AKA
pragma Inline (Spacing);
-- MANPAGE(`menu_pattern.3x')
-- ANCHOR(`set_menu_pattern()',`Set_Pattern')
function Set_Pattern (Men : Menu;
Text : String) return Boolean;
-- AKA
-- Return TRUE if the pattern matches, FALSE otherwise
pragma Inline (Set_Pattern);
-- ANCHOR(`menu_pattern()',`Pattern')
procedure Pattern (Men : Menu;
Text : out String);
-- AKA
pragma Inline (Pattern);
-- MANPAGE(`menu_format.3x')
-- ANCHOR(`set_menu_format()',`Set_Format')
procedure Set_Format (Men : Menu;
Lines : Line_Count;
Columns : Column_Count);
-- Not implemented: 0 argument for Lines or Columns;
-- instead use Format to get the current sizes
-- The default format is 16 rows, 1 column. Calling
-- set_menu_format with a null menu pointer will change this
-- default. A zero row or column argument to set_menu_format
-- is interpreted as a request not to change the current
-- value.
-- AKA
pragma Inline (Set_Format);
-- ANCHOR(`menu_format()',`Format')
procedure Format (Men : Menu;
Lines : out Line_Count;
Columns : out Column_Count);
-- AKA
pragma Inline (Format);
-- MANPAGE(`menu_hook.3x')
type Menu_Hook_Function is access procedure (Men : Menu);
pragma Convention (C, Menu_Hook_Function);
-- ANCHOR(`set_item_init()',`Set_Item_Init_Hook')
procedure Set_Item_Init_Hook (Men : Menu;
Proc : Menu_Hook_Function);
-- AKA
pragma Inline (Set_Item_Init_Hook);
-- ANCHOR(`set_item_term()',`Set_Item_Term_Hook')
procedure Set_Item_Term_Hook (Men : Menu;
Proc : Menu_Hook_Function);
-- AKA
pragma Inline (Set_Item_Term_Hook);
-- ANCHOR(`set_menu_init()',`Set_Menu_Init_Hook')
procedure Set_Menu_Init_Hook (Men : Menu;
Proc : Menu_Hook_Function);
-- AKA
pragma Inline (Set_Menu_Init_Hook);
-- ANCHOR(`set_menu_term()',`Set_Menu_Term_Hook')
procedure Set_Menu_Term_Hook (Men : Menu;
Proc : Menu_Hook_Function);
-- AKA
pragma Inline (Set_Menu_Term_Hook);
-- ANCHOR(`item_init()',`Get_Item_Init_Hook')
function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function;
-- AKA
pragma Inline (Get_Item_Init_Hook);
-- ANCHOR(`item_term()',`Get_Item_Term_Hook')
function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function;
-- AKA
pragma Inline (Get_Item_Term_Hook);
-- ANCHOR(`menu_init()',`Get_Menu_Init_Hook')
function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function;
-- AKA
pragma Inline (Get_Menu_Init_Hook);
-- ANCHOR(`menu_term()',`Get_Menu_Term_Hook')
function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function;
-- AKA
pragma Inline (Get_Menu_Term_Hook);
-- MANPAGE(`menu_items.3x')
-- ANCHOR(`set_menu_items()',`Redefine')
procedure Redefine (Men : Menu;
Items : Item_Array_Access);
-- AKA
pragma Inline (Redefine);
procedure Set_Items (Men : Menu;
Items : Item_Array_Access) renames Redefine;
-- pragma Inline (Set_Items);
-- ANCHOR(`menu_items()',`Items')
function Items (Men : Menu;
Index : Positive) return Item;
-- AKA
pragma Inline (Items);
-- ANCHOR(`item_count()',`Item_Count')
function Item_Count (Men : Menu) return Natural;
-- AKA
pragma Inline (Item_Count);
-- MANPAGE(`menu_new.3x')
-- ANCHOR(`new_menu()',`Create')
function Create (Items : Item_Array_Access) return Menu;
-- AKA
-- Not inlined
function New_Menu (Items : Item_Array_Access) return Menu renames Create;
-- ANCHOR(`free_menu()',`Delete')
procedure Delete (Men : in out Menu);
-- AKA
-- Reset Men to Null_Menu
-- Not inlined
-- MANPAGE(`menu_driver.3x')
type Driver_Result is (Menu_Ok,
Request_Denied,
Unknown_Request,
No_Match);
-- ANCHOR(`menu_driver()',`Driver')
function Driver (Men : Menu;
Key : Key_Code) return Driver_Result;
-- AKA
-- Driver is not inlined
-- ANCHOR(`menu_requestname.3x')
-- Not Implemented: menu_request_name, menu_request_by_name
-------------------------------------------------------------------------------
private
type Item is new System.Storage_Elements.Integer_Address;
type Menu is new System.Storage_Elements.Integer_Address;
Null_Item : constant Item := 0;
Null_Menu : constant Menu := 0;
end Terminal_Interface.Curses.Menus;

182
Ada95/gen/terminal_interface-curses-mouse.ads.m4 Normal file
View File

@ -0,0 +1,182 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-mouse__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Mouse --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-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.28 $
-- $Date: 2009/12/26 17:38:58 $
-- Binding Version 01.00
------------------------------------------------------------------------------
include(`Mouse_Base_Defs')
with System;
package Terminal_Interface.Curses.Mouse is
pragma Preelaborate (Terminal_Interface.Curses.Mouse);
-- MANPAGE(`curs_mouse.3x')
-- Please note, that in ncurses-1.9.9e documentation mouse support
-- is still marked as experimental. So also this binding will change
-- if the ncurses methods change.
--
-- mouse_trafo, wmouse_trafo are implemented as Transform_Coordinates
-- in the parent package.
--
-- Not implemented:
-- REPORT_MOUSE_POSITION (i.e. as a parameter to Register_Reportable_Event
-- or Start_Mouse)
type Event_Mask is private;
No_Events : constant Event_Mask;
All_Events : constant Event_Mask;
type Mouse_Button is (Left, -- aka: Button 1
Middle, -- aka: Button 2
Right, -- aka: Button 3
Button4, -- aka: Button 4
Control, -- Control Key
Shift, -- Shift Key
Alt); -- ALT Key
subtype Real_Buttons is Mouse_Button range Left .. Button4;
subtype Modifier_Keys is Mouse_Button range Control .. Alt;
type Button_State is (Released,
Pressed,
Clicked,
Double_Clicked,
Triple_Clicked);
type Button_States is array (Button_State) of Boolean;
pragma Pack (Button_States);
All_Clicks : constant Button_States := (Clicked .. Triple_Clicked => True,
others => False);
All_States : constant Button_States := (others => True);
type Mouse_Event is private;
-- MANPAGE(`curs_mouse.3x')
function Has_Mouse return Boolean;
-- Return true if a mouse device is supported, false otherwise.
procedure Register_Reportable_Event
(Button : Mouse_Button;
State : Button_State;
Mask : in out Event_Mask);
-- Stores the event described by the button and the state in the mask.
-- Before you call this the first time, you should init the mask
-- with the Empty_Mask constant
pragma Inline (Register_Reportable_Event);
procedure Register_Reportable_Events
(Button : Mouse_Button;
State : Button_States;
Mask : in out Event_Mask);
-- Register all events described by the Button and the State bitmap.
-- Before you call this the first time, you should init the mask
-- with the Empty_Mask constant
-- ANCHOR(`mousemask()',`Start_Mouse')
-- There is one difference to mousmask(): we return the value of the
-- old mask, that means the event mask value before this call.
-- Not Implemented: The library version
-- returns a Mouse_Mask that tells which events are reported.
function Start_Mouse (Mask : Event_Mask := All_Events)
return Event_Mask;
-- AKA
pragma Inline (Start_Mouse);
procedure End_Mouse (Mask : Event_Mask := No_Events);
-- Terminates the mouse, restores the specified event mask
pragma Inline (End_Mouse);
-- ANCHOR(`getmouse()',`Get_Mouse')
function Get_Mouse return Mouse_Event;
-- AKA
pragma Inline (Get_Mouse);
procedure Get_Event (Event : Mouse_Event;
Y : out Line_Position;
X : out Column_Position;
Button : out Mouse_Button;
State : out Button_State);
-- !!! Warning: X and Y are screen coordinates. Due to ripped of lines they
-- may not be identical to window coordinates.
-- Not Implemented: Get_Event only reports one event, the C library
-- version supports multiple events, e.g. {click-1, click-3}
pragma Inline (Get_Event);
-- ANCHOR(`ungetmouse()',`Unget_Mouse')
procedure Unget_Mouse (Event : Mouse_Event);
-- AKA
pragma Inline (Unget_Mouse);
-- ANCHOR(`wenclose()',`Enclosed_In_Window')
function Enclosed_In_Window (Win : Window := Standard_Window;
Event : Mouse_Event) return Boolean;
-- AKA
-- But : use event instead of screen coordinates.
pragma Inline (Enclosed_In_Window);
-- ANCHOR(`mouseinterval()',`Mouse_Interval')
function Mouse_Interval (Msec : Natural := 200) return Natural;
-- AKA
pragma Inline (Mouse_Interval);
private
type Event_Mask is new Interfaces.C.unsigned_long;
type Mouse_Event is
record
Id : Integer range Integer (Interfaces.C.short'First) ..
Integer (Interfaces.C.short'Last);
X, Y, Z : Integer range Integer (Interfaces.C.int'First) ..
Integer (Interfaces.C.int'Last);
Bstate : Event_Mask;
end record;
pragma Convention (C, Mouse_Event);
include(`Mouse_Event_Rep')
Generation_Bit_Order : constant System.Bit_Order := System.M4_BIT_ORDER;
-- This constant may be different on your system.
include(`Mouse_Events')
No_Events : constant Event_Mask := 0;
All_Events : constant Event_Mask := ALL_MOUSE_EVENTS;
end Terminal_Interface.Curses.Mouse;

70
Ada95/gen/terminal_interface-curses-panels-user_data.ads.m4 Normal file
View File

@ -0,0 +1,70 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-panels-user_data__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Panels.User_Data --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-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.15 $
-- Binding Version 01.00
------------------------------------------------------------------------------
generic
type User is limited private;
type User_Access is access all User;
package Terminal_Interface.Curses.Panels.User_Data is
pragma Preelaborate (Terminal_Interface.Curses.Panels.User_Data);
-- MANPAGE(`panel.3x')
-- ANCHOR(`set_panel_userptr',`Set_User_Data')
procedure Set_User_Data (Pan : Panel;
Data : User_Access);
-- AKA
pragma Inline (Set_User_Data);
-- ANCHOR(`panel_userptr',`Get_User_Data')
procedure Get_User_Data (Pan : Panel;
Data : out User_Access);
-- AKA
-- ANCHOR(`panel_userptr',`Get_User_Data')
function Get_User_Data (Pan : Panel) return User_Access;
-- AKA
-- Same as function
pragma Inline (Get_User_Data);
end Terminal_Interface.Curses.Panels.User_Data;

147
Ada95/gen/terminal_interface-curses-panels.ads.m4 Normal file
View File

@ -0,0 +1,147 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-panels__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Panels --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2006,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.20 $
-- $Date: 2009/12/26 17:38:58 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with System;
package Terminal_Interface.Curses.Panels is
pragma Preelaborate (Terminal_Interface.Curses.Panels);
include(`Panel_Linker_Options')dnl
include(`Linker_Options')
type Panel is private;
---------------------------
-- Interface constants --
---------------------------
Null_Panel : constant Panel;
-------------------
-- Exceptions --
-------------------
Panel_Exception : exception;
-- MANPAGE(`panel.3x')
-- ANCHOR(`new_panel()',`Create')
function Create (Win : Window) return Panel;
-- AKA
pragma Inline (Create);
-- ANCHOR(`new_panel()',`New_Panel')
function New_Panel (Win : Window) return Panel renames Create;
-- AKA
-- pragma Inline (New_Panel);
-- ANCHOR(`bottom_panel()',`Bottom')
procedure Bottom (Pan : Panel);
-- AKA
pragma Inline (Bottom);
-- ANCHOR(`top_panel()',`Top')
procedure Top (Pan : Panel);
-- AKA
pragma Inline (Top);
-- ANCHOR(`show_panel()',`Show')
procedure Show (Pan : Panel);
-- AKA
pragma Inline (Show);
-- ANCHOR(`update_panels()',`Update_Panels')
procedure Update_Panels;
-- AKA
pragma Import (C, Update_Panels, "update_panels");
-- ANCHOR(`hide_panel()',`Hide')
procedure Hide (Pan : Panel);
-- AKA
pragma Inline (Hide);
-- ANCHOR(`panel_window()',`Get_Window')
function Get_Window (Pan : Panel) return Window;
-- AKA
pragma Inline (Get_Window);
-- ANCHOR(`panel_window()',`Panel_Window')
function Panel_Window (Pan : Panel) return Window renames Get_Window;
-- pragma Inline (Panel_Window);
-- ANCHOR(`replace_panel()',`Replace')
procedure Replace (Pan : Panel;
Win : Window);
-- AKA
pragma Inline (Replace);
-- ANCHOR(`move_panel()',`Move')
procedure Move (Pan : Panel;
Line : Line_Position;
Column : Column_Position);
-- AKA
pragma Inline (Move);
-- ANCHOR(`panel_hidden()',`Is_Hidden')
function Is_Hidden (Pan : Panel) return Boolean;
-- AKA
pragma Inline (Is_Hidden);
-- ANCHOR(`panel_above()',`Above')
function Above (Pan : Panel) return Panel;
-- AKA
pragma Import (C, Above, "panel_above");
-- ANCHOR(`panel_below()',`Below')
function Below (Pan : Panel) return Panel;
-- AKA
pragma Import (C, Below, "panel_below");
-- ANCHOR(`del_panel()',`Delete')
procedure Delete (Pan : in out Panel);
-- AKA
pragma Inline (Delete);
private
type Panel is new System.Storage_Elements.Integer_Address;
Null_Panel : constant Panel := 0;
end Terminal_Interface.Curses.Panels;

78
Ada95/gen/terminal_interface-curses-trace.ads.m4 Normal file
View File

@ -0,0 +1,78 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-trace__ads.htm')dnl
include(M4MACRO)------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Trace --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control:
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
package Terminal_Interface.Curses.Trace is
pragma Preelaborate (Terminal_Interface.Curses.Trace);
pragma Warnings (Off);
include(`Trace_Defs')
pragma Warnings (On);
Trace_Disable : constant Trace_Attribute_Set := (others => False);
Trace_Ordinary : constant Trace_Attribute_Set :=
(Times => True,
Tputs => True,
Update => True,
Cursor_Move => True,
Character_Output => True,
others => False);
Trace_Maximum : constant Trace_Attribute_Set := (others => True);
------------------------------------------------------------------------------
-- MANPAGE(`curs_trace.3x')
-- ANCHOR(`trace()',`Trace_on')
procedure Trace_On (x : Trace_Attribute_Set);
-- The debugging library has trace.
-- ANCHOR(`_tracef()',`Trace_Put')
procedure Trace_Put (str : String);
-- AKA
Current_Trace_Setting : Trace_Attribute_Set;
pragma Import (C, Current_Trace_Setting, "_nc_tracing");
end Terminal_Interface.Curses.Trace;

2502
Ada95/gen/terminal_interface-curses.adb.m4 Normal file
View File

File diff suppressed because it is too large Load Diff

1559
Ada95/gen/terminal_interface-curses.ads.m4 Normal file
View File

File diff suppressed because it is too large Load Diff

80
Ada95/include/MKncurses_def.sh Executable file
View File

@ -0,0 +1,80 @@
#! /bin/sh
# $Id: MKncurses_def.sh,v 1.2 2003/10/25 16:19:46 tom Exp $
##############################################################################
# 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. #
##############################################################################
#
# MKncurses_def.sh -- generate fallback definitions for ncurses_cfg.h
#
# Author: Thomas E. Dickey 2000
#
# Given the choice between constructs such as
#
# #if defined(foo) && foo
# #if foo
#
# we chose the latter. It is guaranteed by the language standard, and there
# appear to be no broken compilers that do not honor that detail. But some
# people want to use gcc's -Wundef option (corresponding to one of the less
# useful features in Watcom's compiler) to check for misspellings. So we
# generate a set of fallback definitions to quiet the warnings without making
# the code ugly.
#
DEFS="${1-ncurses_defs}"
cat <<EOF
/*
* This file is generated by $0
*/
#ifndef NC_DEFINE_H
#define NC_DEFINE_H 1
EOF
${AWK-awk} <$DEFS '
!/^[@#]/ {
if ( NF == 1 )
{
print "#ifndef", $1
print "#define", $1, "0"
print "#endif"
print ""
} else if ( NF != 0 ) {
print "#ifndef", $1
printf "#define"
for (n = 1; n <= NF; n++) {
printf " %s", $n
}
print ""
print "#endif"
print ""
}
}
END {
print "#endif /* NC_DEFINE_H */"
}
'

90
Ada95/include/Makefile.in Normal file
View File

@ -0,0 +1,90 @@
# $Id: Makefile.in,v 1.2 2010/11/27 21:45:27 tom Exp $
##############################################################################
# Copyright (c) 2010 Free Software Foundation, Inc. #
# #
# Permission is hereby granted, free of charge, to any person obtaining a #
# copy of this software and associated documentation files (the "Software"), #
# to deal in the Software without restriction, including without limitation #
# the rights to use, copy, modify, merge, publish, distribute, distribute #
# with modifications, sublicense, and/or sell copies of the Software, and to #
# permit persons to whom the Software is furnished to do so, subject to the #
# following conditions: #
# #
# The above copyright notice and this permission notice shall be included in #
# all copies or substantial portions of the Software. #
# #
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR #
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, #
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL #
# THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER #
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING #
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER #
# DEALINGS IN THE SOFTWARE. #
# #
# Except as contained in this notice, the name(s) of the above copyright #
# holders shall not be used in advertising or otherwise to promote the sale, #
# use or other dealings in this Software without prior written #
# authorization. #
##############################################################################
#
# Author: Thomas E. Dickey
#
# Makefile for ncurses source code.
#
# This makes header files used when building Ada95 as a separate tree.
#
# The variable 'srcdir' refers to the source-distribution, and can be set with
# the configure script by "--srcdir=DIR".
# turn off _all_ suffix rules; we'll generate our own
.SUFFIXES:
SHELL = /bin/sh
VPATH = @srcdir@
THIS = Makefile
DESTDIR = @DESTDIR@
srcdir = @srcdir@
prefix = @prefix@
exec_prefix = @exec_prefix@
includedir = @includedir@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
AWK = @AWK@
# These files are generated by this makefile
AUTO_SRC = \
ncurses_def.h
################################################################################
all \
libs \
depend \
sources \
install :: $(AUTO_SRC)
ncurses_def.h: $(srcdir)/ncurses_defs $(srcdir)/MKncurses_def.sh
AWK=$(AWK) sh $(srcdir)/MKncurses_def.sh $(srcdir)/ncurses_defs >$@
tags:
ctags *.[ch]
@MAKE_UPPER_TAGS@TAGS:
@MAKE_UPPER_TAGS@ etags *.[ch]
mostlyclean ::
-rm -f core tags TAGS *~ *.bak *.i *.ln *.atac trace
clean :: mostlyclean
-rm -f $(AUTO_SRC)
distclean :: clean
-rm -f Makefile
realclean :: distclean
###############################################################################
# The remainder of this file is automatically generated during configuration
###############################################################################

72
Ada95/include/ncurses_cfg.hin Normal file
View File

@ -0,0 +1,72 @@
/****************************************************************************
* Copyright (c) 1998-2004,2005 Free Software Foundation, Inc. *
* *
* Permission is hereby granted, free of charge, to any person obtaining a *
* copy of this software and associated documentation files (the *
* "Software"), to deal in the Software without restriction, including *
* without limitation the rights to use, copy, modify, merge, publish, *
* distribute, distribute with modifications, sublicense, and/or sell *
* copies of the Software, and to permit persons to whom the Software is *
* furnished to do so, subject to the following conditions: *
* *
* The above copyright notice and this permission notice shall be included *
* in all copies or substantial portions of the Software. *
* *
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS *
* OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *
* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. *
* IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, *
* DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR *
* OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR *
* THE USE OR OTHER DEALINGS IN THE SOFTWARE. *
* *
* Except as contained in this notice, the name(s) of the above copyright *
* holders shall not be used in advertising or otherwise to promote the *
* sale, use or other dealings in this Software without prior written *
* authorization. *
****************************************************************************/
/****************************************************************************
* Author: Thomas E. Dickey <dickey@clark.net> 1997 *
****************************************************************************/
/*
* $Id: ncurses_cfg.hin,v 1.7 2005/01/02 01:26:58 tom Exp $
*
* This is a template-file used to generate the "ncurses_cfg.h" file.
*
* Rather than list every definition, the configuration script substitutes the
* definitions that it finds using 'sed'. You need a patch (original date
* 971222) to autoconf 2.12 or 2.13 to do this.
*
* See:
* http://invisible-island.net/autoconf/
* ftp://invisible-island.net/autoconf/
*/
#ifndef NC_CONFIG_H
#define NC_CONFIG_H
@DEFS@
#include <ncurses_def.h>
/* The C compiler may not treat these properly but C++ has to */
#ifdef __cplusplus
#undef const
#undef inline
#else
#if defined(lint) || defined(TRACE)
#undef inline
#define inline /* nothing */
#endif
#endif
/* On HP-UX, the C compiler doesn't grok mbstate_t without
-D_XOPEN_SOURCE=500. However, this causes problems on
IRIX. So, we #define mbstate_t to int in configure.in
only for the C compiler if needed. */
#ifndef __cplusplus
#ifdef NEED_MBSTATE_T_DEF
#define mbstate_t int
#endif
#endif
#endif /* NC_CONFIG_H */

207
Ada95/include/ncurses_defs Normal file
View File

@ -0,0 +1,207 @@
# $Id: ncurses_defs,v 1.41 2008/11/16 00:19:59 juergen Exp $
##############################################################################
# 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. #
##############################################################################
#
# See "MKncurses_def.sh" for an explanation.
#
# (hint: don't try to define NDEBUG ;-)
BROKEN_LINKER
BSD_TPUTS
CC_HAS_PROTOS
CPP_HAS_PARAM_INIT
CURSES_ACS_ARRAY acs_map
CURSES_WACS_ARRAY _nc_wacs
DECL_ERRNO
ETIP_NEEDS_MATH_H
GCC_NORETURN /* nothing */
GCC_UNUSED /* nothing */
HAVE_BIG_CORE
HAVE_BSD_CGETENT
HAVE_BSD_SIGNAL_H
HAVE_BTOWC
HAVE_BUILTIN_H
HAVE_CHGAT 1
HAVE_COLOR_SET 1
HAVE_DIRENT_H
HAVE_ERRNO
HAVE_FCNTL_H
HAVE_FILTER 1
HAVE_FORM_H
HAVE_GETBEGX 1
HAVE_GETCURX 1
HAVE_GETCWD
HAVE_GETEGID
HAVE_GETEUID
HAVE_GETMAXX 1
HAVE_GETNSTR
HAVE_GETOPT_H
HAVE_GETPARX 1
HAVE_GETTIMEOFDAY
HAVE_GETTTYNAM
HAVE_GETWIN 1
HAVE_GPM_H
HAVE_GPP_BUILTIN_H
HAVE_GXX_BUILTIN_H
HAVE_HAS_KEY
HAVE_IOSTREAM
HAVE_ISASCII
HAVE_ISSETUGID
HAVE_LANGINFO_CODESET
HAVE_LIBC_H
HAVE_LIBDBMALLOC
HAVE_LIBDMALLOC
HAVE_LIBFORM
HAVE_LIBGPM
HAVE_LIBMENU
HAVE_LIBMPATROL
HAVE_LIBPANEL
HAVE_LIMITS_H
HAVE_LINK
HAVE_LOCALE_H
HAVE_LONG_FILE_NAMES
HAVE_MBLEN
HAVE_MBRLEN
HAVE_MBRTOWC
HAVE_MBSRTOWCS
HAVE_MBSTOWCS
HAVE_MBTOWC
HAVE_MENU_H
HAVE_MKSTEMP
HAVE_MVVLINE 1
HAVE_MVWVLINE 1
HAVE_NANOSLEEP
HAVE_NC_ALLOC_H
HAVE_PANEL_H
HAVE_POLL
HAVE_POLL_H
HAVE_PURIFY
HAVE_PUTWC
HAVE_PUTWIN 1
HAVE_REGEXPR_H_FUNCS
HAVE_REGEXP_H_FUNCS
HAVE_REGEX_H_FUNCS
HAVE_REMOVE
HAVE_RESIZETERM
HAVE_RESIZE_TERM
HAVE_RIPOFFLINE 1
HAVE_SELECT
HAVE_SETBUF
HAVE_SETBUFFER
HAVE_SETUPTERM 1
HAVE_SETVBUF
HAVE_SIGACTION
HAVE_SIGVEC
HAVE_SIZECHANGE
HAVE_SLK_COLOR
HAVE_SLK_INIT 1
HAVE_STRDUP
HAVE_STRSTR
HAVE_SYMLINK
HAVE_SYS_BSDTYPES_H
HAVE_SYS_IOCTL_H
HAVE_SYS_PARAM_H
HAVE_SYS_POLL_H
HAVE_SYS_SELECT_H
HAVE_SYS_TERMIO_H
HAVE_SYS_TIMES_H
HAVE_SYS_TIME_H
HAVE_SYS_TIME_SELECT
HAVE_TCGETATTR
HAVE_TCGETPGRP
HAVE_TELL
HAVE_TERMATTRS 1
HAVE_TERMIOS_H
HAVE_TERMIO_H
HAVE_TERMNAME 1
HAVE_TERM_H 1
HAVE_TGETENT 1
HAVE_TIGETNUM 1
HAVE_TIGETSTR 1
HAVE_TIMES
HAVE_TTYENT_H
HAVE_TYPEAHEAD 1
HAVE_TYPEINFO
HAVE_TYPE_ATTR_T
HAVE_TYPE_SIGACTION
HAVE_UNISTD_H
HAVE_UNLINK
HAVE_USE_DEFAULT_COLORS
HAVE_VFSCANF
HAVE_VSNPRINTF
HAVE_VSSCANF
HAVE_WCSRTOMBS
HAVE_WCSTOMBS
HAVE_WCTOB
HAVE_WCTOMB
HAVE_WCTYPE_H
HAVE_WINSSTR 1
HAVE_WORKING_POLL
HAVE_WRESIZE
HAVE__DOSCAN
MIXEDCASE_FILENAMES
NCURSES_CHAR_EQ
NCURSES_EXPANDED
NCURSES_EXT_COLORS
NCURSES_EXT_FUNCS
NCURSES_NO_PADDING
NCURSES_PATHSEP ':'
NEED_PTEM_H
NO_LEAKS
PURE_TERMINFO
RETSIGTYPE
STDC_HEADERS
SVR4_ACTION
SVR4_TERMIO
SYSTEM_NAME "unknown"
TERMINFO "none"
TERMPATH "none"
TIME_WITH_SYS_TIME
TYPEOF_CHTYPE
USE_COLORFGBG
USE_DATABASE
USE_GETCAP
USE_GETCAP_CACHE
USE_HARD_TABS
USE_HASHED_DB
USE_HASHMAP
USE_HOME_TERMINFO
USE_LINKS
USE_MY_MEMMOVE
USE_OK_BCOPY
USE_RCS_IDS
USE_REENTRANT
USE_SAFE_SPRINTF
USE_SCROLL_HINTS
USE_SIGWINCH
USE_SYMLINKS
USE_SYSMOUSE
USE_TERMCAP
USE_WEAK_SYMBOLS
USE_WIDEC_SUPPORT
USE_XMC_SUPPORT

90
Ada95/make-tar.sh Executable file
View File

@ -0,0 +1,90 @@
#!/bin/sh
# $Id: make-tar.sh,v 1.6 2010/11/06 19:59:07 tom Exp $
##############################################################################
# Copyright (c) 2010 Free Software Foundation, Inc. #
# #
# Permission is hereby granted, free of charge, to any person obtaining a #
# copy of this software and associated documentation files (the "Software"), #
# to deal in the Software without restriction, including without limitation #
# the rights to use, copy, modify, merge, publish, distribute, distribute #
# with modifications, sublicense, and/or sell copies of the Software, and to #
# permit persons to whom the Software is furnished to do so, subject to the #
# following conditions: #
# #
# The above copyright notice and this permission notice shall be included in #
# all copies or substantial portions of the Software. #
# #
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR #
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, #
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL #
# THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER #
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING #
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER #
# DEALINGS IN THE SOFTWARE. #
# #
# Except as contained in this notice, the name(s) of the above copyright #
# holders shall not be used in advertising or otherwise to promote the sale, #
# use or other dealings in this Software without prior written #
# authorization. #
##############################################################################
# Construct a tar-file containing only the Ada95 tree as well as its associated
# documentation. The reason for doing that is to simplify distributing the
# ada binding as a separate package.
TARGET=`pwd`
: ${ROOTNAME:=ncurses-Ada95}
: ${DESTDIR:=$TARGET}
: ${TMPDIR:=/tmp}
# This can be run from either the Ada95 subdirectory, or from the top-level
# source directory. We will put the tar file in the original directory.
test -d ./Ada95 && cd ./Ada95
BUILD=$TMPDIR/make-tar$$
trap "cd /; rm -rf $BUILD; exit 0" 0 1 2 5 15
umask 077
if ! ( mkdir $BUILD )
then
echo "? cannot make build directory $BUILD"
fi
umask 022
mkdir $BUILD/$ROOTNAME
cp -p -r * $BUILD/$ROOTNAME/ || exit
# Add the config.* utility scripts from the top-level directory.
for i in . ..
do
for j in config.guess config.sub install-sh tar-copy.sh
do
test -f $i/$j && cp -p $i/$j $BUILD/$ROOTNAME/
done
done
# Add the ada documentation.
mkdir $BUILD/$ROOTNAME/doc || exit
cd ../doc/html || exit
cp -p -r Ada* $BUILD/$ROOTNAME/doc/
cp -p -r ada $BUILD/$ROOTNAME/doc/
cd $BUILD || exit
# There is no need for this script in the tar file.
rm -f $ROOTNAME/make-tar.sh
# Remove build-artifacts.
find . -name RCS -exec rm -rf {} \;
find . -name "*.gz" -exec rm -rf {} \;
# Make the files writable...
chmod -R u+w .
tar cf - $ROOTNAME | gzip >$DESTDIR/$ROOTNAME.tar.gz
cd $DESTDIR
pwd
ls -l $ROOTNAME.tar.gz

90
Ada95/mk-1st.awk Normal file
View File

@ -0,0 +1,90 @@
# $Id: mk-1st.awk,v 1.4 2011/02/22 09:40:01 tom Exp $
##############################################################################
# Copyright (c) 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: Thomas E. Dickey
#
# Generate compile-rules for the Ada95 modules that we are using in libraries
# or programs. This script is used for older versions of gnatmake, which do
# not build libraries reliably, e.g., gnatmake 3.15.
#
# Fields in src/modules:
# $1 = module name
# $2 = directory where spec-dependency ".ads" is found
# $3 = directory where body-dependency ".adb" is found
# $4 = unit to compile (spec or body)
#
BEGIN {
printf "\n";
printf "# generated by Ada95/mk-1st.awk\n";
}
/^[#]/ {
next
}
/^$/ {
next
}
{
printf "\n";
printf "%s.o :", $1;
if ( $2 == "none" ) {
pre_spec = "";
} else if ( $2 == "." ) {
pre_spec = "";
printf " \\\n\t\t%s.ads", $1;
} else {
pre_spec = sprintf("%s/", $2);
printf " \\\n\t\t%s%s.ads", pre_spec, $1;
}
if ( $3 == "none" ) {
pre_body = "";
} else if ( $3 == "." ) {
pre_body = "";
printf " \\\n\t\t%s.adb", $1;
} else {
pre_body = sprintf("%s/", $3);
printf " \\\n\t\t%s%s.adb", pre_body, $1;
printf " \\\n\t\t$(BASEDEPS)";
}
if ( $4 == "spec" ) {
suffix = "ads";
prefix = pre_spec;
} else {
suffix = "adb";
prefix = pre_body;
}
printf "\n";
printf "\t$(ADA) $(ADAFLAGS) -c -o $@ %s%s.%s\n", prefix, $1, suffix
}
END {
print ""
}

133
Ada95/samples/Makefile.in Normal file
View File

@ -0,0 +1,133 @@
##############################################################################
# Copyright (c) 1998-2009,2010 Free Software Foundation, Inc. #
# #
# Permission is hereby granted, free of charge, to any person obtaining a #
# copy of this software and associated documentation files (the "Software"), #
# to deal in the Software without restriction, including without limitation #
# the rights to use, copy, modify, merge, publish, distribute, distribute #
# with modifications, sublicense, and/or sell copies of the Software, and to #
# permit persons to whom the Software is furnished to do so, subject to the #
# following conditions: #
# #
# The above copyright notice and this permission notice shall be included in #
# all copies or substantial portions of the Software. #
# #
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR #
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, #
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL #
# THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER #
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING #
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER #
# DEALINGS IN THE SOFTWARE. #
# #
# Except as contained in this notice, the name(s) of the above copyright #
# holders shall not be used in advertising or otherwise to promote the sale, #
# use or other dealings in this Software without prior written #
# authorization. #
##############################################################################
#
# Author: Juergen Pfeifer, 1996
#
# $Id: Makefile.in,v 1.40 2010/11/27 21:45:27 tom Exp $
#
.SUFFIXES:
SHELL = /bin/sh
VPATH = @srcdir@
THIS = Makefile
x = @PROG_EXT@
srcdir = @srcdir@
prefix = @prefix@
exec_prefix = @exec_prefix@
libdir = @libdir@
includedir = @includedir@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
AWK = @AWK@
LN_S = @LN_S@
CC = @CC@
CFLAGS = @CFLAGS@
CPPFLAGS = @ACPPFLAGS@ \
-DHAVE_CONFIG_H -I$(srcdir)
CCFLAGS = $(CPPFLAGS) $(CFLAGS)
CFLAGS_NORMAL = $(CCFLAGS)
CFLAGS_DEBUG = $(CCFLAGS) @CC_G_OPT@ -DTRACE
CFLAGS_PROFILE = $(CCFLAGS) -pg
CFLAGS_SHARED = $(CCFLAGS) @CC_SHARED_OPTS@
CFLAGS_DEFAULT = $(CFLAGS_@DFT_UPR_MODEL@)
REL_VERSION = @cf_cv_rel_version@
ABI_VERSION = @cf_cv_abi_version@
LOCAL_LIBDIR = @top_builddir@/lib
LINK = $(CC)
LDFLAGS = @LDFLAGS@ @LD_MODEL@ @LIBS@
RANLIB = @RANLIB@
################################################################################
ada_srcdir=../src
LD_FLAGS = @LD_MODEL@ $(LOCAL_LIBS) @LDFLAGS@ @LIBS@ @LOCAL_LDFLAGS2@ $(LDFLAGS)
ADA = @cf_ada_compiler@
ADAFLAGS = @ADAFLAGS@ -I$(srcdir)
ADAMAKE = @cf_ada_make@
ADAMAKEFLAGS = -a -A$(srcdir) -A$(ada_srcdir) -A$(srcdir)/$(ada_srcdir)
ALIB = @cf_ada_package@
ABASE = $(ALIB)-curses
CARGS =-cargs $(ADAFLAGS)
LARGS =-largs @TEST_ARG2@ $(LD_FLAGS) -L../lib -lAdaCurses @TEST_LIBS2@
PROGS = tour rain ncurses
all :: tour$x rain$x ncurses$x
@echo made $@
sources :
@echo made $@
libs \
install \
install.libs ::
@echo made $@
uninstall \
uninstall.libs ::
@echo made $@
ncurses$x :
$(ADAMAKE) $(ADAMAKEFLAGS) ncurses $(CARGS) $(LARGS)
tour$x : explain.msg
$(ADAMAKE) $(ADAMAKEFLAGS) tour $(CARGS) $(LARGS)
explain.msg: $(srcdir)/explain.txt
cp $(srcdir)/explain.txt $@
rain$x :
$(ADAMAKE) $(ADAMAKEFLAGS) rain $(CARGS) $(LARGS)
mostlyclean:
@echo made $@
clean :: mostlyclean
rm -f *.o *.ali b_t*.* *.s $(PROGS) a.out core b_*_test.c *.xr[bs] \
explain.msg trace screendump b~*.ad[bs]
distclean :: clean
rm -f Makefile
realclean :: distclean
@echo made $@

35
Ada95/samples/README Normal file
View File

@ -0,0 +1,35 @@
-------------------------------------------------------------------------------
-- Copyright (c) 1998,2006 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell copies --
-- of the Software, and to permit persons to whom the Software is furnished --
-- to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN --
-- NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE --
-- USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
-------------------------------------------------------------------------------
-- $Id: README,v 1.2 2006/04/22 22:24:12 tom Exp $
-------------------------------------------------------------------------------
The intention of the demo at this point in time is not to demonstrate all
the features of (n)curses and its subsystems, but to give some sample
sources how to use the binding at all.
Ideally in the future we can combine both goals.

186
Ada95/samples/explain.txt Normal file
View File

@ -0,0 +1,186 @@
#VERSION
This is Version 00.90.00 of the demo package.
#MENUKEYS
In a menu you can use the following Keys in the whole application:
- CTRL-X eXit the menu
- CTRL-N Go to next item
- CTRL-P Go to previous item
- CTRL-U Scroll up one line
- CTRL-D Scroll down one line
- CTRL-F Scroll down one page
- PAGE DOWN Scroll down one page
- PAGE UP Scroll back one page
- CTRL-B Scroll back one page
- CTRL-Y Clear pattern
- CTRL-H Delete last character from pattern
- Backspace Delete last character from pattern
- CTRL-A Next pattern match
- CTRL-E Previous pattern match
- CTRL-T Toggle item in a multi-selection menu
- CR or LF Select an item
- HOME Key Go to the first item
- F3 Quit the menu
- Cursor Down Down one item
- Cursor Up Up one item
- Cursor Left Left one item
- Cursor Right Right one item
- END Key Go to last item
#FORMKEYS
- CTRL-X eXit the form
- CTRL-F Go forward to the next field
- CTRL-B Go backward to the previous field
- CTRL-L Go to the field left of the current one
- CTRL-R Go to the field right of the current one
- CTRL-U Go to the field above the current one
- CTRL-D Go to the field below the current one
- CTRL-W Go to the next word in the field
- CTRL-T Go to the previous word in the field
- CTRL-A Go to the beginning of the field
- CTRL-E Go to the end of the field
- CTRL-I Insert a blank character at the current position
- CTRL-O Insert a line
- CTRL-V Delete a character
- CTRL-H Delete previous character
- CTRL-Y Delete a line
- CTRL-G Delete a word
- CTRL-K Clear to end of field
- CTRL-N Next choice in a choice field (Enumerations etc.)
- CTRL-P Previous choice in a choice field.
#HELP
#HELPKEYS
You may scroll with the Cursor Up/Down Keys.
You may leave the help with the Function Key labelled 'Quit'.
#INHELP
You are already in the help system.
You may leave the help with the Function Key labelled 'Quit'.
#MAIN
This is the main menu of the sample program for the ncurses Ada95
binding. The main intention of the demo is not to demonstate or
test all the features of ncurses and it's subsystems, but to provide
to you some sample code how to use the binding with Ada95.
You may select this options:
* Look at some ncurses core functions
* Look at some features of the menu subsystem
* Look at some features of the form subsystem
* Look at the output of the Ada.Text_IO like functions
for ncurses.
#MAINPAD
You may press at any place in this demo CTRL-C. This will give you a command
window. You can just type in the Label-String of a function key, then this
key will be simulated. This should help you to run the application even if
you run it on a terminal with no or only a few function keys. With CTRL-N
and CTRL-P you may browse through the possible values in the command window.
#MENU00
Here we give you a selection of various menu demonstrations.
#MENU-PAD00
This menu itself is a demo for a single valued, 1-column menu with
descriptions for the items, a marker and a padding character between
the item name and the description.
#MENU01
This is a demo of the some of the menu layout options. One of them
is the spacing functionality. Just press the Key labelled "Flip" to
flip between the non-spaced and a spaced version of the menu. Please
note that this functionality is unique for ncurses and is not found
in the SVr4 menu implementation.
This is a menu that sometimes doesn't fit into it's window and
therefore it becomes a scroll menu.
You can also see here very nicely the pattern matching functionality
of menus. Type for example a 'J' and you will be positioned to the
next item after the current starting with a 'J'. Any more characters
you type in make the pattern more specific. With CTRL-A and CTRL-Z
(for more details press the Key labelled "Keys") you can browse
through all the items matching the pattern.
You may change the format of the menu. Just press one of the keys
labelled "4x1", "4x2" or "4x3" to get a menu with that many rows
and columns.
With the Keys "O-Row" or "O-Col" (they occupy the same label and
switch on selection) you can change the major order scheme for
the menu. If "O-Col" is visible, the menu is currently major
ordered by rows, you can switch to major column order by pressing
the key. If "O-Row" is visible, it's just the reverse situation.
This Key is not visible in "4x1" layout mode, because in this case
the functionality makes no sense.
With the Keys "Multi" or "Singl" (they occupy the same label and
switch on selection) you can change whether or not the menu allows
multiple or only single selection.
With the Keys "+Desc" or "-Desc" (they occupy the same label and
switch on selection) you can change whether or not the descriptions
for each item should be displayed. Please not that this key is
not visible in the "4x3" layout mode, because in this case the
menu wouldn't fit on a typicall 80x24 screen.
With the Keys "Disab" or "Enab" (they occupy the same label and
switch on selection) you can dis- or enable the selectability of
the month with 31 days.
#MENU-PAD01
You may press "Flip" to see the effect of ncurses unique menu-spacing.
The Keys "4x1", "4x2" and "4x3" will change the format of the menu.
Please note that this is a scrolling menu. You may also play with the
pattern matching functionality or try to change the format of the menu.
For more details press the Key labelled "Help".
#FORM00
This is a demo of the forms package.
#FORM-PAD00
Please note that this demo is far from being complete. It really shows
only a small part of the functionality of the forms package. Let's hope
the next version will have a richer demo (You wan't to contribute ?).
#NOTIMPL
Sorry this functionality of the demo is not implemented at the moment.
Remember this is a freeware project, so I can use only my very rare
free time to continue coding. If you would like to contribute, you
are very welcome !
#CURSES00
This is a menu where you can select some different demos of the ncurses
functionality.
#CURSES-PAD00
Please note that this demo is far from being complete. It really shows
only a small part of the functionality of the curses package. Let's hope
the next version will have a richer demo (You wan't to contribute ?).
#MOUSEKEYS
In this demo you may use this keys:
- Key labelled "Help" to get a help
- Key labelled "Keys" is what you are reading now
- Key labelled "Quit" to leave the demo
You may click the mouse buttons at any location at the screen and look
at the protocol window !
#MOUSE00
A rather simple use of a mouse as demo. It's there just to test the
code and to provide the sample source.
It might be of interest, that the output into the protocol window is
done by the (n)curses Text_IO subpackages. Especially the output of
the button and state names is done by Ads's enumeration IO, which
allows you to print the names of enumeration literals. That's really
nice.
#MOUSE-PAD00
This is a very simple demo of the mouse features of ncurses. It's there
just to test whether or not the generated code for the binding really
works on the different architectures (seems so).
#ATTRIBDEMO
Again this is a more than simple demo and just here to give you the
sourcecode.
#ATTRIBKEYS
You may press one of the three well known standard keys of this demo.
#ATTRIB-PAD00
Again this is a more than simple demo and just here to give you the
sourcecode. Feel free to contribute more.
#TEXTIO
#TEXTIOKEYS
#TEXTIO-PAD00
#END

47
Ada95/samples/ncurses.adb Normal file
View File

@ -0,0 +1,47 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with ncurses2.m; use ncurses2.m;
with GNAT.OS_Lib; use GNAT.OS_Lib;
procedure ncurses is
begin
OS_Exit (main);
end ncurses;

714
Ada95/samples/ncurses2-acs_and_scroll.adb Normal file
View File

@ -0,0 +1,714 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000-2008,2009 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.9 $
-- $Date: 2009/12/26 17:38:58 $
-- Binding Version 01.00
------------------------------------------------------------------------------
-- Windows and scrolling tester.
-- Demonstrate windows
with Ada.Strings.Fixed;
with Ada.Strings;
with ncurses2.util; use ncurses2.util;
with ncurses2.genericPuts;
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
with Terminal_Interface.Curses.PutWin; use Terminal_Interface.Curses.PutWin;
with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
with Ada.Streams; use Ada.Streams;
procedure ncurses2.acs_and_scroll is
Macro_Quit : constant Key_Code := Character'Pos ('Q') mod 16#20#;
Macro_Escape : constant Key_Code := Character'Pos ('[') mod 16#20#;
Quit : constant Key_Code := CTRL ('Q');
Escape : constant Key_Code := CTRL ('[');
Botlines : constant Line_Position := 4;
type pair is record
y : Line_Position;
x : Column_Position;
end record;
type Frame;
type FrameA is access Frame;
f : File_Type;
dumpfile : constant String := "screendump";
procedure Outerbox (ul, lr : pair; onoff : Boolean);
function HaveKeyPad (w : Window) return Boolean;
function HaveScroll (w : Window) return Boolean;
procedure newwin_legend (curpw : Window);
procedure transient (curpw : Window; msg : String);
procedure newwin_report (win : Window := Standard_Window);
procedure selectcell (uli : Line_Position;
ulj : Column_Position;
lri : Line_Position;
lrj : Column_Position;
p : out pair;
b : out Boolean);
function getwindow return Window;
procedure newwin_move (win : Window;
dy : Line_Position;
dx : Column_Position);
function delete_framed (fp : FrameA; showit : Boolean) return FrameA;
-- A linked list
-- I wish there was a standard library linked list. Oh well.
type Frame is record
next, last : FrameA;
do_scroll : Boolean;
do_keypad : Boolean;
wind : Window;
end record;
current : FrameA;
c : Key_Code;
procedure Outerbox (ul, lr : pair; onoff : Boolean) is
begin
if onoff then
-- Note the fix of an obscure bug
-- try making a 1x1 box then enlarging it, the is a blank
-- upper left corner!
Add (Line => ul.y - 1, Column => ul.x - 1,
Ch => ACS_Map (ACS_Upper_Left_Corner));
Add (Line => ul.y - 1, Column => lr.x + 1,
Ch => ACS_Map (ACS_Upper_Right_Corner));
Add (Line => lr.y + 1, Column => lr.x + 1,
Ch => ACS_Map (ACS_Lower_Right_Corner));
Add (Line => lr.y + 1, Column => ul.x - 1,
Ch => ACS_Map (ACS_Lower_Left_Corner));
Move_Cursor (Line => ul.y - 1, Column => ul.x);
Horizontal_Line (Line_Symbol => ACS_Map (ACS_Horizontal_Line),
Line_Size => Integer (lr.x - ul.x) + 1);
Move_Cursor (Line => ul.y, Column => ul.x - 1);
Vertical_Line (Line_Symbol => ACS_Map (ACS_Vertical_Line),
Line_Size => Integer (lr.y - ul.y) + 1);
Move_Cursor (Line => lr.y + 1, Column => ul.x);
Horizontal_Line (Line_Symbol => ACS_Map (ACS_Horizontal_Line),
Line_Size => Integer (lr.x - ul.x) + 1);
Move_Cursor (Line => ul.y, Column => lr.x + 1);
Vertical_Line (Line_Symbol => ACS_Map (ACS_Vertical_Line),
Line_Size => Integer (lr.y - ul.y) + 1);
else
Add (Line => ul.y - 1, Column => ul.x - 1, Ch => ' ');
Add (Line => ul.y - 1, Column => lr.x + 1, Ch => ' ');
Add (Line => lr.y + 1, Column => lr.x + 1, Ch => ' ');
Add (Line => lr.y + 1, Column => ul.x - 1, Ch => ' ');
Move_Cursor (Line => ul.y - 1, Column => ul.x);
Horizontal_Line (Line_Symbol => Blank2,
Line_Size => Integer (lr.x - ul.x) + 1);
Move_Cursor (Line => ul.y, Column => ul.x - 1);
Vertical_Line (Line_Symbol => Blank2,
Line_Size => Integer (lr.y - ul.y) + 1);
Move_Cursor (Line => lr.y + 1, Column => ul.x);
Horizontal_Line (Line_Symbol => Blank2,
Line_Size => Integer (lr.x - ul.x) + 1);
Move_Cursor (Line => ul.y, Column => lr.x + 1);
Vertical_Line (Line_Symbol => Blank2,
Line_Size => Integer (lr.y - ul.y) + 1);
end if;
end Outerbox;
function HaveKeyPad (w : Window) return Boolean is
begin
return Get_KeyPad_Mode (w);
exception
when Curses_Exception => return False;
end HaveKeyPad;
function HaveScroll (w : Window) return Boolean is
begin
return Scrolling_Allowed (w);
exception
when Curses_Exception => return False;
end HaveScroll;
procedure newwin_legend (curpw : Window) is
package p is new genericPuts (200);
use p;
use p.BS;
type string_a is access String;
type rrr is record
msg : string_a;
code : Integer range 0 .. 3;
end record;
legend : constant array (Positive range <>) of rrr :=
(
(
new String'("^C = create window"), 0
),
(
new String'("^N = next window"), 0
),
(
new String'("^P = previous window"), 0
),
(
new String'("^F = scroll forward"), 0
),
(
new String'("^B = scroll backward"), 0
),
(
new String'("^K = keypad(%s)"), 1
),
(
new String'("^S = scrollok(%s)"), 2
),
(
new String'("^W = save window to file"), 0
),
(
new String'("^R = restore window"), 0
),
(
new String'("^X = resize"), 0
),
(
new String'("^Q%s = exit"), 3
)
);
buf : Bounded_String;
do_keypad : constant Boolean := HaveKeyPad (curpw);
do_scroll : constant Boolean := HaveScroll (curpw);
pos : Natural;
mypair : pair;
use Ada.Strings.Fixed;
begin
Move_Cursor (Line => Lines - 4, Column => 0);
for n in legend'Range loop
pos := Ada.Strings.Fixed.Index (Source => legend (n).msg.all,
Pattern => "%s");
-- buf := (others => ' ');
buf := To_Bounded_String (legend (n).msg.all);
case legend (n).code is
when 0 => null;
when 1 =>
if do_keypad then
Replace_Slice (buf, pos, pos + 1, "yes");
else
Replace_Slice (buf, pos, pos + 1, "no");
end if;
when 2 =>
if do_scroll then
Replace_Slice (buf, pos, pos + 1, "yes");
else
Replace_Slice (buf, pos, pos + 1, "no");
end if;
when 3 =>
if do_keypad then
Replace_Slice (buf, pos, pos + 1, "/ESC");
else
Replace_Slice (buf, pos, pos + 1, "");
end if;
end case;
Get_Cursor_Position (Line => mypair.y, Column => mypair.x);
if Columns < mypair.x + 3 + Column_Position (Length (buf)) then
Add (Ch => newl);
elsif n /= 1 then -- n /= legen'First
Add (Str => ", ");
end if;
myAdd (Str => buf);
end loop;
Clear_To_End_Of_Line;
end newwin_legend;
procedure transient (curpw : Window; msg : String) is
begin
newwin_legend (curpw);
if msg /= "" then
Add (Line => Lines - 1, Column => 0, Str => msg);
Refresh;
Nap_Milli_Seconds (1000);
end if;
Move_Cursor (Line => Lines - 1, Column => 0);
if HaveKeyPad (curpw) then
Add (Str => "Non-arrow");
else
Add (Str => "All other");
end if;
Add (Str => " characters are echoed, window should ");
if not HaveScroll (curpw) then
Add (Str => "not ");
end if;
Add (Str => "scroll");
Clear_To_End_Of_Line;
end transient;
procedure newwin_report (win : Window := Standard_Window) is
y : Line_Position;
x : Column_Position;
use Int_IO;
tmp2a : String (1 .. 2);
tmp2b : String (1 .. 2);
begin
if win /= Standard_Window then
transient (win, "");
end if;
Get_Cursor_Position (win, y, x);
Move_Cursor (Line => Lines - 1, Column => Columns - 17);
Put (tmp2a, Integer (y));
Put (tmp2b, Integer (x));
Add (Str => "Y = " & tmp2a & " X = " & tmp2b);
if win /= Standard_Window then
Refresh;
else
Move_Cursor (win, y, x);
end if;
end newwin_report;
procedure selectcell (uli : Line_Position;
ulj : Column_Position;
lri : Line_Position;
lrj : Column_Position;
p : out pair;
b : out Boolean) is
c : Key_Code;
res : pair;
i : Line_Position := 0;
j : Column_Position := 0;
si : constant Line_Position := lri - uli + 1;
sj : constant Column_Position := lrj - ulj + 1;
begin
res.y := uli;
res.x := ulj;
loop
Move_Cursor (Line => uli + i, Column => ulj + j);
newwin_report;
c := Getchar;
case c is
when
Macro_Quit |
Macro_Escape =>
-- on the same line macro calls interfere due to the # comment
-- this is needed because keypad off affects all windows.
-- try removing the ESCAPE and see what happens.
b := False;
return;
when KEY_UP =>
i := i + si - 1;
-- same as i := i - 1 because of Modulus arithetic,
-- on Line_Position, which is a Natural
-- the C version uses this form too, interestingly.
when KEY_DOWN =>
i := i + 1;
when KEY_LEFT =>
j := j + sj - 1;
when KEY_RIGHT =>
j := j + 1;
when Key_Mouse =>
declare
event : Mouse_Event;
y : Line_Position;
x : Column_Position;
Button : Mouse_Button;
State : Button_State;
begin
event := Get_Mouse;
Get_Event (Event => event,
Y => y,
X => x,
Button => Button,
State => State);
if y > uli and x > ulj then
i := y - uli;
j := x - ulj;
-- same as when others =>
res.y := uli + i;
res.x := ulj + j;
p := res;
b := True;
return;
else
Beep;
end if;
end;
when others =>
res.y := uli + i;
res.x := ulj + j;
p := res;
b := True;
return;
end case;
i := i mod si;
j := j mod sj;
end loop;
end selectcell;
function getwindow return Window is
rwindow : Window;
ul, lr : pair;
result : Boolean;
begin
Move_Cursor (Line => 0, Column => 0);
Clear_To_End_Of_Line;
Add (Str => "Use arrows to move cursor, anything else to mark corner 1");
Refresh;
selectcell (2, 1, Lines - Botlines - 2, Columns - 2, ul, result);
if not result then
return Null_Window;
end if;
Add (Line => ul.y - 1, Column => ul.x - 1,
Ch => ACS_Map (ACS_Upper_Left_Corner));
Move_Cursor (Line => 0, Column => 0);
Clear_To_End_Of_Line;
Add (Str => "Use arrows to move cursor, anything else to mark corner 2");
Refresh;
selectcell (ul.y, ul.x, Lines - Botlines - 2, Columns - 2, lr, result);
if not result then
return Null_Window;
end if;
rwindow := Sub_Window (Number_Of_Lines => lr.y - ul.y + 1,
Number_Of_Columns => lr.x - ul.x + 1,
First_Line_Position => ul.y,
First_Column_Position => ul.x);
Outerbox (ul, lr, True);
Refresh;
Refresh (rwindow);
Move_Cursor (Line => 0, Column => 0);
Clear_To_End_Of_Line;
return rwindow;
end getwindow;
procedure newwin_move (win : Window;
dy : Line_Position;
dx : Column_Position) is
cur_y, max_y : Line_Position;
cur_x, max_x : Column_Position;
begin
Get_Cursor_Position (win, cur_y, cur_x);
Get_Size (win, max_y, max_x);
cur_x := Column_Position'Min (Column_Position'Max (cur_x + dx, 0),
max_x - 1);
cur_y := Line_Position'Min (Line_Position'Max (cur_y + dy, 0),
max_y - 1);
Move_Cursor (win, Line => cur_y, Column => cur_x);
end newwin_move;
function delete_framed (fp : FrameA; showit : Boolean) return FrameA is
np : FrameA;
begin
fp.last.next := fp.next;
fp.next.last := fp.last;
if showit then
Erase (fp.wind);
Refresh (fp.wind);
end if;
Delete (fp.wind);
if fp = fp.next then
np := null;
else
np := fp.next;
end if;
-- TODO free(fp);
return np;
end delete_framed;
Mask : Event_Mask := No_Events;
Mask2 : Event_Mask;
usescr : Window;
begin
if Has_Mouse then
Register_Reportable_Event (
Button => Left,
State => Clicked,
Mask => Mask);
Mask2 := Start_Mouse (Mask);
end if;
c := CTRL ('C');
Set_Raw_Mode (SwitchOn => True);
loop
transient (Standard_Window, "");
case c is
when Character'Pos ('c') mod 16#20# => -- Ctrl('c')
declare
neww : constant FrameA := new Frame'(null, null,
False, False,
Null_Window);
begin
neww.wind := getwindow;
if neww.wind = Null_Window then
exit;
-- was goto breakout; ha ha ha
else
if current = null then
neww.next := neww;
neww.last := neww;
else
neww.next := current.next;
neww.last := current;
neww.last.next := neww;
neww.next.last := neww;
end if;
current := neww;
Set_KeyPad_Mode (current.wind, True);
current.do_keypad := HaveKeyPad (current.wind);
current.do_scroll := HaveScroll (current.wind);
end if;
end;
when Character'Pos ('N') mod 16#20# => -- Ctrl('N')
if current /= null then
current := current.next;
end if;
when Character'Pos ('P') mod 16#20# => -- Ctrl('P')
if current /= null then
current := current.last;
end if;
when Character'Pos ('F') mod 16#20# => -- Ctrl('F')
if current /= null and then HaveScroll (current.wind) then
Scroll (current.wind, 1);
end if;
when Character'Pos ('B') mod 16#20# => -- Ctrl('B')
if current /= null and then HaveScroll (current.wind) then
-- The C version of Scroll may return ERR which is ignored
-- we need to avoid the exception
-- with the 'and HaveScroll(current.wind)'
Scroll (current.wind, -1);
end if;
when Character'Pos ('K') mod 16#20# => -- Ctrl('K')
if current /= null then
current.do_keypad := not current.do_keypad;
Set_KeyPad_Mode (current.wind, current.do_keypad);
end if;
when Character'Pos ('S') mod 16#20# => -- Ctrl('S')
if current /= null then
current.do_scroll := not current.do_scroll;
Allow_Scrolling (current.wind, current.do_scroll);
end if;
when Character'Pos ('W') mod 16#20# => -- Ctrl('W')
if current /= current.next then
Create (f, Name => dumpfile); -- TODO error checking
if not Is_Open (f) then
raise Curses_Exception;
end if;
Put_Window (current.wind, f);
Close (f);
current := delete_framed (current, True);
end if;
when Character'Pos ('R') mod 16#20# => -- Ctrl('R')
declare
neww : FrameA := new Frame'(null, null, False, False,
Null_Window);
begin
Open (f, Mode => In_File, Name => dumpfile);
neww := new Frame'(null, null, False, False, Null_Window);
neww.next := current.next;
neww.last := current;
neww.last.next := neww;
neww.next.last := neww;
neww.wind := Get_Window (f);
Close (f);
Refresh (neww.wind);
end;
when Character'Pos ('X') mod 16#20# => -- Ctrl('X')
if current /= null then
declare
tmp, ul, lr : pair;
mx : Column_Position;
my : Line_Position;
tmpbool : Boolean;
begin
Move_Cursor (Line => 0, Column => 0);
Clear_To_End_Of_Line;
Add (Str => "Use arrows to move cursor, anything else " &
"to mark new corner");
Refresh;
Get_Window_Position (current.wind, ul.y, ul.x);
selectcell (ul.y, ul.x, Lines - Botlines - 2, Columns - 2,
tmp, tmpbool);
if not tmpbool then
-- the C version had a goto. I refuse gotos.
Beep;
else
Get_Size (current.wind, lr.y, lr.x);
lr.y := lr.y + ul.y - 1;
lr.x := lr.x + ul.x - 1;
Outerbox (ul, lr, False);
Refresh_Without_Update;
Get_Size (current.wind, my, mx);
if my > tmp.y - ul.y then
Get_Cursor_Position (current.wind, lr.y, lr.x);
Move_Cursor (current.wind, tmp.y - ul.y + 1, 0);
Clear_To_End_Of_Screen (current.wind);
Move_Cursor (current.wind, lr.y, lr.x);
end if;
if mx > tmp.x - ul.x then
for i in 0 .. my - 1 loop
Move_Cursor (current.wind, i, tmp.x - ul.x + 1);
Clear_To_End_Of_Line (current.wind);
end loop;
end if;
Refresh_Without_Update (current.wind);
lr := tmp;
-- The C version passes invalid args to resize
-- which returns an ERR. For Ada we avoid the exception.
if lr.y /= ul.y and lr.x /= ul.x then
Resize (current.wind, lr.y - ul.y + 0,
lr.x - ul.x + 0);
end if;
Get_Window_Position (current.wind, ul.y, ul.x);
Get_Size (current.wind, lr.y, lr.x);
lr.y := lr.y + ul.y - 1;
lr.x := lr.x + ul.x - 1;
Outerbox (ul, lr, True);
Refresh_Without_Update;
Refresh_Without_Update (current.wind);
Move_Cursor (Line => 0, Column => 0);
Clear_To_End_Of_Line;
Update_Screen;
end if;
end;
end if;
when Key_F10 =>
declare tmp : pair; tmpbool : Boolean;
begin
-- undocumented --- use this to test area clears
selectcell (0, 0, Lines - 1, Columns - 1, tmp, tmpbool);
Clear_To_End_Of_Screen;
Refresh;
end;
when Key_Cursor_Up =>
newwin_move (current.wind, -1, 0);
when Key_Cursor_Down =>
newwin_move (current.wind, 1, 0);
when Key_Cursor_Left =>
newwin_move (current.wind, 0, -1);
when Key_Cursor_Right =>
newwin_move (current.wind, 0, 1);
when Key_Backspace | Key_Delete_Char =>
declare
y : Line_Position;
x : Column_Position;
tmp : Line_Position;
begin
Get_Cursor_Position (current.wind, y, x);
-- x := x - 1;
-- I got tricked by the -1 = Max_Natural - 1 result
-- y := y - 1;
if not (x = 0 and y = 0) then
if x = 0 then
y := y - 1;
Get_Size (current.wind, tmp, x);
end if;
x := x - 1;
Delete_Character (current.wind, y, x);
end if;
end;
when others =>
-- TODO c = '\r' ?
if current /= null then
declare
begin
Add (current.wind, Ch => Code_To_Char (c));
exception
when Curses_Exception => null;
-- this happens if we are at the
-- lower right of a window and add a character.
end;
else
Beep;
end if;
end case;
newwin_report (current.wind);
if current /= null then
usescr := current.wind;
else
usescr := Standard_Window;
end if;
Refresh (usescr);
c := Getchar (usescr);
exit when c = Quit or (c = Escape and HaveKeyPad (usescr));
-- TODO when does c = ERR happen?
end loop;
-- TODO while current /= null loop
-- current := delete_framed(current, False);
-- end loop;
Allow_Scrolling (Mode => True);
End_Mouse (Mask2);
Set_Raw_Mode (SwitchOn => True);
Erase;
End_Windows;
end ncurses2.acs_and_scroll;

41
Ada95/samples/ncurses2-acs_and_scroll.ads Normal file
View File

@ -0,0 +1,41 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
procedure ncurses2.acs_and_scroll;

235
Ada95/samples/ncurses2-acs_display.adb Normal file
View File

@ -0,0 +1,235 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000-2006,2008 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.6 $
-- $Date: 2008/07/26 18:47:34 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with ncurses2.util; use ncurses2.util;
with ncurses2.genericPuts;
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Ada.Strings.Unbounded;
with Ada.Strings.Fixed;
procedure ncurses2.acs_display is
use Int_IO;
procedure show_upper_chars (first : Integer);
function show_1_acs (N : Integer;
name : String;
code : Attributed_Character)
return Integer;
procedure show_acs_chars;
procedure show_upper_chars (first : Integer) is
C1 : constant Boolean := (first = 128);
last : constant Integer := first + 31;
package p is new ncurses2.genericPuts (200);
use p;
use p.BS;
use Ada.Strings.Unbounded;
tmpa : Unbounded_String;
tmpb : BS.Bounded_String;
begin
Erase;
Switch_Character_Attribute
(Attr => (Bold_Character => True, others => False));
Move_Cursor (Line => 0, Column => 20);
tmpa := To_Unbounded_String ("Display of ");
if C1 then
tmpa := tmpa & "C1";
else
tmpa := tmpa & "GR";
end if;
tmpa := tmpa & " Character Codes ";
myPut (tmpb, first);
Append (tmpa, To_String (tmpb));
Append (tmpa, " to ");
myPut (tmpb, last);
Append (tmpa, To_String (tmpb));
Add (Str => To_String (tmpa));
Switch_Character_Attribute
(On => False,
Attr => (Bold_Character => True, others => False));
Refresh;
for code in first .. last loop
declare
row : constant Line_Position
:= Line_Position (4 + ((code - first) mod 16));
col : constant Column_Position
:= Column_Position (((code - first) / 16) *
Integer (Columns) / 2);
tmp3 : String (1 .. 3);
tmpx : String (1 .. Integer (Columns / 4));
reply : Key_Code;
begin
Put (tmp3, code);
myPut (tmpb, code, 16);
tmpa := To_Unbounded_String (tmp3 & " (" & To_String (tmpb) & ')');
Ada.Strings.Fixed.Move (To_String (tmpa), tmpx,
Justify => Ada.Strings.Right);
Add (Line => row, Column => col,
Str => tmpx & ' ' & ':' & ' ');
if C1 then
Set_NoDelay_Mode (Mode => True);
end if;
Add_With_Immediate_Echo (Ch => Code_To_Char (Key_Code (code)));
-- TODO check this
if C1 then
reply := Getchar;
while reply /= Key_None loop
Add (Ch => Code_To_Char (reply));
Nap_Milli_Seconds (10);
reply := Getchar;
end loop;
Set_NoDelay_Mode (Mode => False);
end if;
end;
end loop;
end show_upper_chars;
function show_1_acs (N : Integer;
name : String;
code : Attributed_Character)
return Integer is
height : constant Integer := 16;
row : constant Line_Position := Line_Position (4 + (N mod height));
col : constant Column_Position := Column_Position ((N / height) *
Integer (Columns) / 2);
tmpx : String (1 .. Integer (Columns) / 3);
begin
Ada.Strings.Fixed.Move (name, tmpx,
Justify => Ada.Strings.Right,
Drop => Ada.Strings.Left);
Add (Line => row, Column => col, Str => tmpx & ' ' & ':' & ' ');
-- we need more room than C because our identifiers are longer
-- 22 chars actually
Add (Ch => code);
return N + 1;
end show_1_acs;
procedure show_acs_chars is
n : Integer;
begin
Erase;
Switch_Character_Attribute
(Attr => (Bold_Character => True, others => False));
Add (Line => 0, Column => 20,
Str => "Display of the ACS Character Set");
Switch_Character_Attribute (On => False,
Attr => (Bold_Character => True,
others => False));
Refresh;
-- the following is useful to generate the below
-- grep '^[ ]*ACS_' ../src/terminal_interface-curses.ads |
-- awk '{print "n := show_1_acs(n, \""$1"\", ACS_Map("$1"));"}'
n := show_1_acs (0, "ACS_Upper_Left_Corner",
ACS_Map (ACS_Upper_Left_Corner));
n := show_1_acs (n, "ACS_Lower_Left_Corner",
ACS_Map (ACS_Lower_Left_Corner));
n := show_1_acs (n, "ACS_Upper_Right_Corner",
ACS_Map (ACS_Upper_Right_Corner));
n := show_1_acs (n, "ACS_Lower_Right_Corner",
ACS_Map (ACS_Lower_Right_Corner));
n := show_1_acs (n, "ACS_Left_Tee", ACS_Map (ACS_Left_Tee));
n := show_1_acs (n, "ACS_Right_Tee", ACS_Map (ACS_Right_Tee));
n := show_1_acs (n, "ACS_Bottom_Tee", ACS_Map (ACS_Bottom_Tee));
n := show_1_acs (n, "ACS_Top_Tee", ACS_Map (ACS_Top_Tee));
n := show_1_acs (n, "ACS_Horizontal_Line",
ACS_Map (ACS_Horizontal_Line));
n := show_1_acs (n, "ACS_Vertical_Line", ACS_Map (ACS_Vertical_Line));
n := show_1_acs (n, "ACS_Plus_Symbol", ACS_Map (ACS_Plus_Symbol));
n := show_1_acs (n, "ACS_Scan_Line_1", ACS_Map (ACS_Scan_Line_1));
n := show_1_acs (n, "ACS_Scan_Line_9", ACS_Map (ACS_Scan_Line_9));
n := show_1_acs (n, "ACS_Diamond", ACS_Map (ACS_Diamond));
n := show_1_acs (n, "ACS_Checker_Board", ACS_Map (ACS_Checker_Board));
n := show_1_acs (n, "ACS_Degree", ACS_Map (ACS_Degree));
n := show_1_acs (n, "ACS_Plus_Minus", ACS_Map (ACS_Plus_Minus));
n := show_1_acs (n, "ACS_Bullet", ACS_Map (ACS_Bullet));
n := show_1_acs (n, "ACS_Left_Arrow", ACS_Map (ACS_Left_Arrow));
n := show_1_acs (n, "ACS_Right_Arrow", ACS_Map (ACS_Right_Arrow));
n := show_1_acs (n, "ACS_Down_Arrow", ACS_Map (ACS_Down_Arrow));
n := show_1_acs (n, "ACS_Up_Arrow", ACS_Map (ACS_Up_Arrow));
n := show_1_acs (n, "ACS_Board_Of_Squares",
ACS_Map (ACS_Board_Of_Squares));
n := show_1_acs (n, "ACS_Lantern", ACS_Map (ACS_Lantern));
n := show_1_acs (n, "ACS_Solid_Block", ACS_Map (ACS_Solid_Block));
n := show_1_acs (n, "ACS_Scan_Line_3", ACS_Map (ACS_Scan_Line_3));
n := show_1_acs (n, "ACS_Scan_Line_7", ACS_Map (ACS_Scan_Line_7));
n := show_1_acs (n, "ACS_Less_Or_Equal", ACS_Map (ACS_Less_Or_Equal));
n := show_1_acs (n, "ACS_Greater_Or_Equal",
ACS_Map (ACS_Greater_Or_Equal));
n := show_1_acs (n, "ACS_PI", ACS_Map (ACS_PI));
n := show_1_acs (n, "ACS_Not_Equal", ACS_Map (ACS_Not_Equal));
n := show_1_acs (n, "ACS_Sterling", ACS_Map (ACS_Sterling));
if n = 0 then
raise Constraint_Error;
end if;
end show_acs_chars;
c1 : Key_Code;
c : Character := 'a';
begin
loop
case c is
when 'a' =>
show_acs_chars;
when '0' | '1' | '2' | '3' =>
show_upper_chars (ctoi (c) * 32 + 128);
when others =>
null;
end case;
Add (Line => Lines - 3, Column => 0,
Str => "Note: ANSI terminals may not display C1 characters.");
Add (Line => Lines - 2, Column => 0,
Str => "Select: a=ACS, 0=C1, 1,2,3=GR characters, q=quit");
Refresh;
c1 := Getchar;
c := Code_To_Char (c1);
exit when c = 'q' or c = 'x';
end loop;
Pause;
Erase;
End_Windows;
end ncurses2.acs_display;

41
Ada95/samples/ncurses2-acs_display.ads Normal file
View File

@ -0,0 +1,41 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
procedure ncurses2.acs_display;

362
Ada95/samples/ncurses2-attr_test.adb Normal file
View File

@ -0,0 +1,362 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000-2007,2008 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.9 $
-- $Date: 2008/07/26 18:47:26 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with ncurses2.util; use ncurses2.util;
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Terminal_Interface.Curses.Terminfo;
use Terminal_Interface.Curses.Terminfo;
with Ada.Characters.Handling;
with Ada.Strings.Fixed;
procedure ncurses2.attr_test is
function subset (super, sub : Character_Attribute_Set) return Boolean;
function intersect (b, a : Character_Attribute_Set) return Boolean;
function has_A_COLOR (attr : Attributed_Character) return Boolean;
function show_attr (row : Line_Position;
skip : Natural;
attr : Character_Attribute_Set;
name : String;
once : Boolean) return Line_Position;
procedure attr_getc (skip : in out Integer;
fg, bg : in out Color_Number;
result : out Boolean);
function subset (super, sub : Character_Attribute_Set) return Boolean is
begin
if
(super.Stand_Out or not sub.Stand_Out) and
(super.Under_Line or not sub.Under_Line) and
(super.Reverse_Video or not sub.Reverse_Video) and
(super.Blink or not sub.Blink) and
(super.Dim_Character or not sub.Dim_Character) and
(super.Bold_Character or not sub.Bold_Character) and
(super.Alternate_Character_Set or not sub.Alternate_Character_Set) and
(super.Invisible_Character or not sub.Invisible_Character) -- and
-- (super.Protected_Character or not sub.Protected_Character) and
-- (super.Horizontal or not sub.Horizontal) and
-- (super.Left or not sub.Left) and
-- (super.Low or not sub.Low) and
-- (super.Right or not sub.Right) and
-- (super.Top or not sub.Top) and
-- (super.Vertical or not sub.Vertical)
then
return True;
else
return False;
end if;
end subset;
function intersect (b, a : Character_Attribute_Set) return Boolean is
begin
if
(a.Stand_Out and b.Stand_Out) or
(a.Under_Line and b.Under_Line) or
(a.Reverse_Video and b.Reverse_Video) or
(a.Blink and b.Blink) or
(a.Dim_Character and b.Dim_Character) or
(a.Bold_Character and b.Bold_Character) or
(a.Alternate_Character_Set and b.Alternate_Character_Set) or
(a.Invisible_Character and b.Invisible_Character) -- or
-- (a.Protected_Character and b.Protected_Character) or
-- (a.Horizontal and b.Horizontal) or
-- (a.Left and b.Left) or
-- (a.Low and b.Low) or
-- (a.Right and b.Right) or
-- (a.Top and b.Top) or
-- (a.Vertical and b.Vertical)
then
return True;
else
return False;
end if;
end intersect;
function has_A_COLOR (attr : Attributed_Character) return Boolean is
begin
if attr.Color /= Color_Pair (0) then
return True;
else
return False;
end if;
end has_A_COLOR;
-- Print some text with attributes.
function show_attr (row : Line_Position;
skip : Natural;
attr : Character_Attribute_Set;
name : String;
once : Boolean) return Line_Position is
function make_record (n : Integer) return Character_Attribute_Set;
function make_record (n : Integer) return Character_Attribute_Set is
-- unsupported means true
a : Character_Attribute_Set := (others => False);
m : Integer;
rest : Integer;
begin
-- ncv is a bitmap with these fields
-- A_STANDOUT,
-- A_UNDERLINE,
-- A_REVERSE,
-- A_BLINK,
-- A_DIM,
-- A_BOLD,
-- A_INVIS,
-- A_PROTECT,
-- A_ALTCHARSET
-- It means no_color_video,
-- video attributes that can't be used with colors
-- see man terminfo.5
m := n mod 2;
rest := n / 2;
if 1 = m then
a.Stand_Out := True;
end if;
m := rest mod 2;
rest := rest / 2;
if 1 = m then
a.Under_Line := True;
end if;
m := rest mod 2;
rest := rest / 2;
if 1 = m then
a.Reverse_Video := True;
end if;
m := rest mod 2;
rest := rest / 2;
if 1 = m then
a.Blink := True;
end if;
m := rest mod 2;
rest := rest / 2;
if 1 = m then
a.Bold_Character := True;
end if;
m := rest mod 2;
rest := rest / 2;
if 1 = m then
a.Invisible_Character := True;
end if;
m := rest mod 2;
rest := rest / 2;
if 1 = m then
a.Protected_Character := True;
end if;
m := rest mod 2;
rest := rest / 2;
if 1 = m then
a.Alternate_Character_Set := True;
end if;
return a;
end make_record;
ncv : constant Integer := Get_Number ("ncv");
begin
Move_Cursor (Line => row, Column => 8);
Add (Str => name & " mode:");
Move_Cursor (Line => row, Column => 24);
Add (Ch => '|');
if skip /= 0 then
-- printw("%*s", skip, " ")
Add (Str => Ada.Strings.Fixed."*" (skip, ' '));
end if;
if once then
Switch_Character_Attribute (Attr => attr);
else
Set_Character_Attributes (Attr => attr);
end if;
Add (Str => "abcde fghij klmno pqrst uvwxy z");
if once then
Switch_Character_Attribute (Attr => attr, On => False);
end if;
if skip /= 0 then
Add (Str => Ada.Strings.Fixed."*" (skip, ' '));
end if;
Add (Ch => '|');
if attr /= Normal_Video then
declare begin
if not subset (super => Supported_Attributes, sub => attr) then
Add (Str => " (N/A)");
elsif ncv > 0 and has_A_COLOR (Get_Background) then
declare
Color_Supported_Attributes :
constant Character_Attribute_Set := make_record (ncv);
begin
if intersect (Color_Supported_Attributes, attr) then
Add (Str => " (NCV) ");
end if;
end;
end if;
end;
end if;
return row + 2;
end show_attr;
procedure attr_getc (skip : in out Integer;
fg, bg : in out Color_Number;
result : out Boolean) is
ch : constant Key_Code := Getchar;
nc : constant Color_Number := Color_Number (Number_Of_Colors);
begin
result := True;
if Ada.Characters.Handling.Is_Digit (Character'Val (ch)) then
skip := ctoi (Code_To_Char (ch));
elsif ch = CTRL ('L') then
Touch;
Touch (Current_Window);
Refresh;
elsif Has_Colors then
case ch is
-- Note the mathematical elegance compared to the C version.
when Character'Pos ('f') => fg := (fg + 1) mod nc;
when Character'Pos ('F') => fg := (fg - 1) mod nc;
when Character'Pos ('b') => bg := (bg + 1) mod nc;
when Character'Pos ('B') => bg := (bg - 1) mod nc;
when others =>
result := False;
end case;
else
result := False;
end if;
end attr_getc;
-- pairs could be defined as array ( Color_Number(0) .. colors - 1) of
-- array (Color_Number(0).. colors - 1) of Boolean;
pairs : array (Color_Pair'Range) of Boolean := (others => False);
fg, bg : Color_Number := Black; -- = 0;
xmc : constant Integer := Get_Number ("xmc");
skip : Integer := xmc;
n : Integer;
use Int_IO;
begin
pairs (0) := True;
if skip < 0 then
skip := 0;
end if;
n := skip;
loop
declare
row : Line_Position := 2;
normal : Attributed_Character := Blank2;
-- ???
begin
-- row := 2; -- weird, row is set to 0 without this.
-- TODO delete the above line, it was a gdb quirk that confused me
if Has_Colors then
declare pair : constant Color_Pair :=
Color_Pair (fg * Color_Number (Number_Of_Colors) + bg);
begin
-- Go though each color pair. Assume that the number of
-- Redefinable_Color_Pairs is 8*8 with predefined Colors 0..7
if not pairs (pair) then
Init_Pair (pair, fg, bg);
pairs (pair) := True;
end if;
normal.Color := pair;
end;
end if;
Set_Background (Ch => normal);
Erase;
Add (Line => 0, Column => 20,
Str => "Character attribute test display");
row := show_attr (row, n, (Stand_Out => True, others => False),
"STANDOUT", True);
row := show_attr (row, n, (Reverse_Video => True, others => False),
"REVERSE", True);
row := show_attr (row, n, (Bold_Character => True, others => False),
"BOLD", True);
row := show_attr (row, n, (Under_Line => True, others => False),
"UNDERLINE", True);
row := show_attr (row, n, (Dim_Character => True, others => False),
"DIM", True);
row := show_attr (row, n, (Blink => True, others => False),
"BLINK", True);
-- row := show_attr (row, n, (Protected_Character => True,
-- others => False), "PROTECT", True);
row := show_attr (row, n, (Invisible_Character => True,
others => False), "INVISIBLE", True);
row := show_attr (row, n, Normal_Video, "NORMAL", False);
Move_Cursor (Line => row, Column => 8);
if xmc > -1 then
Add (Str => "This terminal does have the magic-cookie glitch");
else
Add (Str => "This terminal does not have the magic-cookie glitch");
end if;
Move_Cursor (Line => row + 1, Column => 8);
Add (Str => "Enter a digit to set gaps on each side of " &
"displayed attributes");
Move_Cursor (Line => row + 2, Column => 8);
Add (Str => "^L = repaint");
if Has_Colors then
declare tmp1 : String (1 .. 1);
begin
Add (Str => ". f/F/b/F toggle colors (");
Put (tmp1, Integer (fg));
Add (Str => tmp1);
Add (Ch => '/');
Put (tmp1, Integer (bg));
Add (Str => tmp1);
Add (Ch => ')');
end;
end if;
Refresh;
end;
declare result : Boolean; begin
attr_getc (n, fg, bg, result);
exit when not result;
end;
end loop;
Set_Background (Ch => Blank2);
Erase;
End_Windows;
end ncurses2.attr_test;

42
Ada95/samples/ncurses2-attr_test.ads Normal file
View File

@ -0,0 +1,42 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000,2006 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.2 $
-- $Date: 2006/06/25 14:24:40 $
-- Binding Version 01.00
------------------------------------------------------------------------------
procedure ncurses2.attr_test;

259
Ada95/samples/ncurses2-color_edit.adb Normal file
View File

@ -0,0 +1,259 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000-2006,2009 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.6 $
-- $Date: 2009/12/26 17:38:58 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with ncurses2.util; use ncurses2.util;
with ncurses2.genericPuts;
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
procedure ncurses2.color_edit is
use Int_IO;
type RGB_Enum is (Redx, Greenx, Bluex);
procedure change_color (current : Color_Number;
field : RGB_Enum;
value : RGB_Value;
usebase : Boolean);
procedure change_color (current : Color_Number;
field : RGB_Enum;
value : RGB_Value;
usebase : Boolean) is
red, green, blue : RGB_Value;
begin
if usebase then
Color_Content (current, red, green, blue);
else
red := 0;
green := 0;
blue := 0;
end if;
case field is
when Redx => red := red + value;
when Greenx => green := green + value;
when Bluex => blue := blue + value;
end case;
declare
begin
Init_Color (current, red, green, blue);
exception
when Curses_Exception => Beep;
end;
end change_color;
package x is new ncurses2.genericPuts (100); use x;
tmpb : x.BS.Bounded_String;
tmp4 : String (1 .. 4);
tmp6 : String (1 .. 6);
tmp8 : String (1 .. 8);
-- This would be easier if Ada had a Bounded_String
-- defined as a class instead of the inferior generic package,
-- then I could define Put, Add, and Get for them. Blech.
value : RGB_Value := 0;
red, green, blue : RGB_Value;
max_colors : constant Natural := Number_Of_Colors;
current : Color_Number := 0;
field : RGB_Enum := Redx;
this_c : Key_Code := 0;
begin
Refresh;
for i in Color_Number'(0) .. Color_Number (Number_Of_Colors) loop
Init_Pair (Color_Pair (i), White, i);
end loop;
Move_Cursor (Line => Lines - 2, Column => 0);
Add (Str => "Number: ");
myPut (tmpb, Integer (value));
myAdd (Str => tmpb);
loop
Switch_Character_Attribute (On => False,
Attr => (Bold_Character => True,
others => False));
Add (Line => 0, Column => 20, Str => "Color RGB Value Editing");
Switch_Character_Attribute (On => False,
Attr => (Bold_Character => True,
others => False));
for i in Color_Number'(0) .. Color_Number (Number_Of_Colors) loop
Move_Cursor (Line => 2 + Line_Position (i), Column => 0);
if current = i then
Add (Ch => '>');
else
Add (Ch => ' ');
end if;
-- TODO if i <= color_names'Max then
Put (tmp8, Integer (i));
Set_Character_Attributes (Color => Color_Pair (i));
Add (Str => " ");
Set_Character_Attributes;
Refresh;
Color_Content (i, red, green, blue);
Add (Str => " R = ");
if current = i and field = Redx then
Switch_Character_Attribute (On => True,
Attr => (Stand_Out => True,
others => False));
end if;
Put (tmp4, Integer (red));
Add (Str => tmp4);
if current = i and field = Redx then
Set_Character_Attributes;
end if;
Add (Str => " G = ");
if current = i and field = Greenx then
Switch_Character_Attribute (On => True,
Attr => (Stand_Out => True,
others => False));
end if;
Put (tmp4, Integer (green));
Add (Str => tmp4);
if current = i and field = Greenx then
Set_Character_Attributes;
end if;
Add (Str => " B = ");
if current = i and field = Bluex then
Switch_Character_Attribute (On => True,
Attr => (Stand_Out => True,
others => False));
end if;
Put (tmp4, Integer (blue));
Add (Str => tmp4);
if current = i and field = Bluex then
Set_Character_Attributes;
end if;
Set_Character_Attributes;
Add (Ch => ')');
end loop;
Add (Line => Line_Position (Number_Of_Colors + 3), Column => 0,
Str => "Use up/down to select a color, left/right to change " &
"fields.");
Add (Line => Line_Position (Number_Of_Colors + 4), Column => 0,
Str => "Modify field by typing nnn=, nnn-, or nnn+. ? for help.");
Move_Cursor (Line => 2 + Line_Position (current), Column => 0);
this_c := Getchar;
if Is_Digit (this_c) then
value := 0;
end if;
case this_c is
when KEY_UP =>
current := (current - 1) mod Color_Number (max_colors);
when KEY_DOWN =>
current := (current + 1) mod Color_Number (max_colors);
when KEY_RIGHT =>
field := RGB_Enum'Val ((RGB_Enum'Pos (field) + 1) mod 3);
when KEY_LEFT =>
field := RGB_Enum'Val ((RGB_Enum'Pos (field) - 1) mod 3);
when
Character'Pos ('0') |
Character'Pos ('1') |
Character'Pos ('2') |
Character'Pos ('3') |
Character'Pos ('4') |
Character'Pos ('5') |
Character'Pos ('6') |
Character'Pos ('7') |
Character'Pos ('8') |
Character'Pos ('9') =>
value := value * 10 + RGB_Value (ctoi (Code_To_Char (this_c)));
when Character'Pos ('+') =>
change_color (current, field, value, True);
when Character'Pos ('-') =>
change_color (current, field, -value, True);
when Character'Pos ('=') =>
change_color (current, field, value, False);
when Character'Pos ('?') =>
Erase;
P (" RGB Value Editing Help");
P ("");
P ("You are in the RGB value editor. Use the arrow keys to " &
"select one of");
P ("the fields in one of the RGB triples of the current colors;" &
" the one");
P ("currently selected will be reverse-video highlighted.");
P ("");
P ("To change a field, enter the digits of the new value; they" &
" are echoed");
P ("as entered. Finish by typing `='. The change will take" &
" effect instantly.");
P ("To increment or decrement a value, use the same procedure," &
" but finish");
P ("with a `+' or `-'.");
P ("");
P ("To quit, do `x' or 'q'");
Pause;
Erase;
when Character'Pos ('q') |
Character'Pos ('x') =>
null;
when others =>
Beep;
end case;
Move_Cursor (Line => Lines - 2, Column => 0);
Put (tmp6, Integer (value));
Add (Str => "Number: " & tmp6);
Clear_To_End_Of_Line;
exit when this_c = Character'Pos ('x') or
this_c = Character'Pos ('q');
end loop;
Erase;
End_Windows;
end ncurses2.color_edit;

41
Ada95/samples/ncurses2-color_edit.ads Normal file
View File

@ -0,0 +1,41 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
procedure ncurses2.color_edit;

163
Ada95/samples/ncurses2-color_test.adb Normal file
View File

@ -0,0 +1,163 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000-2006,2008 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.3 $
-- $Date: 2008/07/26 18:47:17 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with ncurses2.util; use ncurses2.util;
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Ada.Strings.Fixed;
procedure ncurses2.color_test is
use Int_IO;
procedure show_color_name (y, x : Integer; color : Integer);
color_names : constant array (0 .. 15) of String (1 .. 7) :=
(
"black ",
"red ",
"green ",
"yellow ",
"blue ",
"magenta",
"cyan ",
"white ",
"BLACK ",
"RED ",
"GREEN ",
"YELLOW ",
"BLUE ",
"MAGENTA",
"CYAN ",
"WHITE "
);
procedure show_color_name (y, x : Integer; color : Integer) is
tmp5 : String (1 .. 5);
begin
if Number_Of_Colors > 8 then
Put (tmp5, color);
Add (Line => Line_Position (y), Column => Column_Position (x),
Str => tmp5);
else
Add (Line => Line_Position (y), Column => Column_Position (x),
Str => color_names (color));
end if;
end show_color_name;
top, width : Integer;
hello : String (1 .. 5);
-- tmp3 : String (1 .. 3);
-- tmp2 : String (1 .. 2);
begin
Refresh;
Add (Str => "There are ");
-- Put(tmp3, Number_Of_Colors*Number_Of_Colors);
Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors *
Number_Of_Colors),
Ada.Strings.Left));
Add (Str => " color pairs");
Add (Ch => newl);
if Number_Of_Colors > 8 then
width := 4;
else
width := 8;
end if;
if Number_Of_Colors > 8 then
hello := "Test ";
else
hello := "Hello";
end if;
for Bright in Boolean loop
if Number_Of_Colors > 8 then
top := 0;
else
top := Boolean'Pos (Bright) * (Number_Of_Colors + 3);
end if;
Clear_To_End_Of_Screen;
Move_Cursor (Line => Line_Position (top) + 1, Column => 0);
-- Put(tmp2, Number_Of_Colors);
Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors),
Ada.Strings.Left));
Add (Ch => 'x');
Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors),
Ada.Strings.Left));
Add (Str => " matrix of foreground/background colors, bright *");
if Bright then
Add (Str => "on");
else
Add (Str => "off");
end if;
Add (Ch => '*');
for i in 0 .. Number_Of_Colors - 1 loop
show_color_name (top + 2, (i + 1) * width, i);
end loop;
for i in 0 .. Number_Of_Colors - 1 loop
show_color_name (top + 3 + i, 0, i);
end loop;
for i in 1 .. Number_Of_Color_Pairs - 1 loop
Init_Pair (Color_Pair (i), Color_Number (i mod Number_Of_Colors),
Color_Number (i / Number_Of_Colors));
-- attron((attr_t) COLOR_PAIR(i)) -- Huh?
Set_Color (Pair => Color_Pair (i));
if Bright then
Switch_Character_Attribute (Attr => (Bold_Character => True,
others => False));
end if;
Add (Line => Line_Position (top + 3 + (i / Number_Of_Colors)),
Column => Column_Position ((i mod Number_Of_Colors + 1) *
width),
Str => hello);
Set_Character_Attributes;
end loop;
if Number_Of_Colors > 8 or Bright then
Pause;
end if;
end loop;
Erase;
End_Windows;
end ncurses2.color_test;

41
Ada95/samples/ncurses2-color_test.ads Normal file
View File

@ -0,0 +1,41 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
procedure ncurses2.color_test;

497
Ada95/samples/ncurses2-demo_forms.adb Normal file
View File

@ -0,0 +1,497 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000-2004,2006 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.5 $
-- $Date: 2006/06/25 14:24:40 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with ncurses2.util; use ncurses2.util;
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Terminal_Interface.Curses.Forms; use Terminal_Interface.Curses.Forms;
with Terminal_Interface.Curses.Forms.Field_User_Data;
with Ada.Characters.Handling;
with Ada.Strings;
with Ada.Strings.Bounded;
procedure ncurses2.demo_forms is
package BS is new Ada.Strings.Bounded.Generic_Bounded_Length (80);
type myptr is access Integer;
-- The C version stores a pointer in the userptr and
-- converts it into a long integer.
-- The correct, but inconvenient way to do it is to use a
-- pointer to long and keep the pointer constant.
-- It just adds one memory piece to allocate and deallocate (not done here)
package StringData is new
Terminal_Interface.Curses.Forms.Field_User_Data (Integer, myptr);
function edit_secure (me : Field; c_in : Key_Code) return Key_Code;
function form_virtualize (f : Form; w : Window) return Key_Code;
function my_form_driver (f : Form; c : Key_Code) return Boolean;
function make_label (frow : Line_Position;
fcol : Column_Position;
label : String) return Field;
function make_field (frow : Line_Position;
fcol : Column_Position;
rows : Line_Count;
cols : Column_Count;
secure : Boolean) return Field;
procedure display_form (f : Form);
procedure erase_form (f : Form);
-- prints '*' instead of characters.
-- Not that this keeps a bug from the C version:
-- type in the psasword field then move off and back.
-- the cursor is at position one, but
-- this assumes it as at the end so text gets appended instead
-- of overwtitting.
function edit_secure (me : Field; c_in : Key_Code) return Key_Code is
rows, frow : Line_Position;
nrow : Natural;
cols, fcol : Column_Position;
nbuf : Buffer_Number;
c : Key_Code := c_in;
c2 : Character;
use StringData;
begin
Info (me, rows, cols, frow, fcol, nrow, nbuf);
-- TODO if result = Form_Ok and nbuf > 0 then
-- C version checked the return value
-- of Info, the Ada binding throws an exception I think.
if nbuf > 0 then
declare
temp : BS.Bounded_String;
temps : String (1 .. 10);
-- TODO Get_Buffer povides no information on the field length?
len : myptr;
begin
Get_Buffer (me, 1, Str => temps);
-- strcpy(temp, field_buffer(me, 1));
Get_User_Data (me, len);
temp := BS.To_Bounded_String (temps (1 .. len.all));
if c <= Key_Max then
c2 := Code_To_Char (c);
if Ada.Characters.Handling.Is_Graphic (c2) then
BS.Append (temp, c2);
len.all := len.all + 1;
Set_Buffer (me, 1, BS.To_String (temp));
c := Character'Pos ('*');
else
c := 0;
end if;
else
case c is
when REQ_BEG_FIELD |
REQ_CLR_EOF |
REQ_CLR_EOL |
REQ_DEL_LINE |
REQ_DEL_WORD |
REQ_DOWN_CHAR |
REQ_END_FIELD |
REQ_INS_CHAR |
REQ_INS_LINE |
REQ_LEFT_CHAR |
REQ_NEW_LINE |
REQ_NEXT_WORD |
REQ_PREV_WORD |
REQ_RIGHT_CHAR |
REQ_UP_CHAR =>
c := 0; -- we don't want to do inline editing
when REQ_CLR_FIELD =>
if len.all /= 0 then
temp := BS.To_Bounded_String ("");
Set_Buffer (me, 1, BS.To_String (temp));
len.all := 0;
end if;
when REQ_DEL_CHAR |
REQ_DEL_PREV =>
if len.all /= 0 then
BS.Delete (temp, BS.Length (temp), BS.Length (temp));
Set_Buffer (me, 1, BS.To_String (temp));
len.all := len.all - 1;
end if;
when others => null;
end case;
end if;
end;
end if;
return c;
end edit_secure;
mode : Key_Code := REQ_INS_MODE;
function form_virtualize (f : Form; w : Window) return Key_Code is
type lookup_t is record
code : Key_Code;
result : Key_Code;
-- should be Form_Request_Code, but we need MAX_COMMAND + 1
end record;
lookup : constant array (Positive range <>) of lookup_t :=
(
(
Character'Pos ('A') mod 16#20#, REQ_NEXT_CHOICE
),
(
Character'Pos ('B') mod 16#20#, REQ_PREV_WORD
),
(
Character'Pos ('C') mod 16#20#, REQ_CLR_EOL
),
(
Character'Pos ('D') mod 16#20#, REQ_DOWN_FIELD
),
(
Character'Pos ('E') mod 16#20#, REQ_END_FIELD
),
(
Character'Pos ('F') mod 16#20#, REQ_NEXT_PAGE
),
(
Character'Pos ('G') mod 16#20#, REQ_DEL_WORD
),
(
Character'Pos ('H') mod 16#20#, REQ_DEL_PREV
),
(
Character'Pos ('I') mod 16#20#, REQ_INS_CHAR
),
(
Character'Pos ('K') mod 16#20#, REQ_CLR_EOF
),
(
Character'Pos ('L') mod 16#20#, REQ_LEFT_FIELD
),
(
Character'Pos ('M') mod 16#20#, REQ_NEW_LINE
),
(
Character'Pos ('N') mod 16#20#, REQ_NEXT_FIELD
),
(
Character'Pos ('O') mod 16#20#, REQ_INS_LINE
),
(
Character'Pos ('P') mod 16#20#, REQ_PREV_FIELD
),
(
Character'Pos ('R') mod 16#20#, REQ_RIGHT_FIELD
),
(
Character'Pos ('S') mod 16#20#, REQ_BEG_FIELD
),
(
Character'Pos ('U') mod 16#20#, REQ_UP_FIELD
),
(
Character'Pos ('V') mod 16#20#, REQ_DEL_CHAR
),
(
Character'Pos ('W') mod 16#20#, REQ_NEXT_WORD
),
(
Character'Pos ('X') mod 16#20#, REQ_CLR_FIELD
),
(
Character'Pos ('Y') mod 16#20#, REQ_DEL_LINE
),
(
Character'Pos ('Z') mod 16#20#, REQ_PREV_CHOICE
),
(
Character'Pos ('[') mod 16#20#, -- ESCAPE
Form_Request_Code'Last + 1
),
(
Key_Backspace, REQ_DEL_PREV
),
(
KEY_DOWN, REQ_DOWN_CHAR
),
(
Key_End, REQ_LAST_FIELD
),
(
Key_Home, REQ_FIRST_FIELD
),
(
KEY_LEFT, REQ_LEFT_CHAR
),
(
KEY_LL, REQ_LAST_FIELD
),
(
Key_Next, REQ_NEXT_FIELD
),
(
KEY_NPAGE, REQ_NEXT_PAGE
),
(
KEY_PPAGE, REQ_PREV_PAGE
),
(
Key_Previous, REQ_PREV_FIELD
),
(
KEY_RIGHT, REQ_RIGHT_CHAR
),
(
KEY_UP, REQ_UP_CHAR
),
(
Character'Pos ('Q') mod 16#20#, -- QUIT
Form_Request_Code'Last + 1 -- TODO MAX_FORM_COMMAND + 1
)
);
c : Key_Code := Getchar (w);
me : constant Field := Current (f);
begin
if c = Character'Pos (']') mod 16#20# then
if mode = REQ_INS_MODE then
mode := REQ_OVL_MODE;
else
mode := REQ_INS_MODE;
end if;
c := mode;
else
for n in lookup'Range loop
if lookup (n).code = c then
c := lookup (n).result;
exit;
end if;
end loop;
end if;
-- Force the field that the user is typing into to be in reverse video,
-- while the other fields are shown underlined.
if c <= Key_Max then
c := edit_secure (me, c);
Set_Background (me, (Reverse_Video => True, others => False));
elsif c <= Form_Request_Code'Last then
c := edit_secure (me, c);
Set_Background (me, (Under_Line => True, others => False));
end if;
return c;
end form_virtualize;
function my_form_driver (f : Form; c : Key_Code) return Boolean is
flag : constant Driver_Result := Driver (f, F_Validate_Field);
begin
if c = Form_Request_Code'Last + 1
and flag = Form_Ok then
return True;
else
Beep;
return False;
end if;
end my_form_driver;
function make_label (frow : Line_Position;
fcol : Column_Position;
label : String) return Field is
f : constant Field := Create (1, label'Length, frow, fcol, 0, 0);
o : Field_Option_Set := Get_Options (f);
begin
if f /= Null_Field then
Set_Buffer (f, 0, label);
o.Active := False;
Set_Options (f, o);
end if;
return f;
end make_label;
function make_field (frow : Line_Position;
fcol : Column_Position;
rows : Line_Count;
cols : Column_Count;
secure : Boolean) return Field is
f : Field;
use StringData;
len : myptr;
begin
if secure then
f := Create (rows, cols, frow, fcol, 0, 1);
else
f := Create (rows, cols, frow, fcol, 0, 0);
end if;
if f /= Null_Field then
Set_Background (f, (Under_Line => True, others => False));
len := new Integer;
len.all := 0;
Set_User_Data (f, len);
end if;
return f;
end make_field;
procedure display_form (f : Form) is
w : Window;
rows : Line_Count;
cols : Column_Count;
begin
Scale (f, rows, cols);
w := New_Window (rows + 2, cols + 4, 0, 0);
if w /= Null_Window then
Set_Window (f, w);
Set_Sub_Window (f, Derived_Window (w, rows, cols, 1, 2));
Box (w); -- 0,0
Set_KeyPad_Mode (w, True);
end if;
-- TODO if Post(f) /= Form_Ok then it's a procedure
declare
begin
Post (f);
exception
when
Eti_System_Error |
Eti_Bad_Argument |
Eti_Posted |
Eti_Connected |
Eti_Bad_State |
Eti_No_Room |
Eti_Not_Posted |
Eti_Unknown_Command |
Eti_No_Match |
Eti_Not_Selectable |
Eti_Not_Connected |
Eti_Request_Denied |
Eti_Invalid_Field |
Eti_Current =>
Refresh (w);
end;
-- end if;
end display_form;
procedure erase_form (f : Form) is
w : Window := Get_Window (f);
s : Window := Get_Sub_Window (f);
begin
Post (f, False);
Erase (w);
Refresh (w);
Delete (s);
Delete (w);
end erase_form;
finished : Boolean := False;
f : constant Field_Array_Access := new Field_Array (1 .. 12);
secure : Field;
myform : Form;
w : Window;
c : Key_Code;
result : Driver_Result;
begin
Move_Cursor (Line => 18, Column => 0);
Add (Str => "Defined form-traversal keys: ^Q/ESC- exit form");
Add (Ch => newl);
Add (Str => "^N -- go to next field ^P -- go to previous field");
Add (Ch => newl);
Add (Str => "Home -- go to first field End -- go to last field");
Add (Ch => newl);
Add (Str => "^L -- go to field to left ^R -- go to field to right");
Add (Ch => newl);
Add (Str => "^U -- move upward to field ^D -- move downward to field");
Add (Ch => newl);
Add (Str => "^W -- go to next word ^B -- go to previous word");
Add (Ch => newl);
Add (Str => "^S -- go to start of field ^E -- go to end of field");
Add (Ch => newl);
Add (Str => "^H -- delete previous char ^Y -- delete line");
Add (Ch => newl);
Add (Str => "^G -- delete current word ^C -- clear to end of line");
Add (Ch => newl);
Add (Str => "^K -- clear to end of field ^X -- clear field");
Add (Ch => newl);
Add (Str => "Arrow keys move within a field as you would expect.");
Add (Line => 4, Column => 57, Str => "Forms Entry Test");
Refresh;
-- describe the form
f (1) := make_label (0, 15, "Sample Form");
f (2) := make_label (2, 0, "Last Name");
f (3) := make_field (3, 0, 1, 18, False);
f (4) := make_label (2, 20, "First Name");
f (5) := make_field (3, 20, 1, 12, False);
f (6) := make_label (2, 34, "Middle Name");
f (7) := make_field (3, 34, 1, 12, False);
f (8) := make_label (5, 0, "Comments");
f (9) := make_field (6, 0, 4, 46, False);
f (10) := make_label (5, 20, "Password:");
f (11) := make_field (5, 30, 1, 9, True);
secure := f (11);
f (12) := Null_Field;
myform := New_Form (f);
display_form (myform);
w := Get_Window (myform);
Set_Raw_Mode (SwitchOn => True);
Set_NL_Mode (SwitchOn => True); -- lets us read ^M's
while not finished loop
c := form_virtualize (myform, w);
result := Driver (myform, c);
case result is
when Form_Ok =>
Add (Line => 5, Column => 57, Str => Get_Buffer (secure, 1));
Clear_To_End_Of_Line;
Refresh;
when Unknown_Request =>
finished := my_form_driver (myform, c);
when others =>
Beep;
end case;
end loop;
erase_form (myform);
-- TODO Free_Form(myform);
-- for (c = 0; f[c] != 0; c++) free_field(f[c]);
Set_Raw_Mode (SwitchOn => False);
Set_NL_Mode (SwitchOn => True);
end ncurses2.demo_forms;

41
Ada95/samples/ncurses2-demo_forms.ads Normal file
View File

@ -0,0 +1,41 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
procedure ncurses2.demo_forms;

675
Ada95/samples/ncurses2-demo_pad.adb Normal file
View File

@ -0,0 +1,675 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000-2006,2008 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.7 $
-- $Date: 2008/07/26 18:47:06 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with ncurses2.util; use ncurses2.util;
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Interfaces.C;
with System.Storage_Elements;
with System.Address_To_Access_Conversions;
with Ada.Text_IO;
-- with Ada.Real_Time; use Ada.Real_Time;
-- TODO is there a way to use Real_Time or Ada.Calendar in place of
-- gettimeofday?
-- Demonstrate pads.
procedure ncurses2.demo_pad is
type timestruct is record
seconds : Integer;
microseconds : Integer;
end record;
type myfunc is access function (w : Window) return Key_Code;
function gettime return timestruct;
procedure do_h_line (y : Line_Position;
x : Column_Position;
c : Attributed_Character;
to : Column_Position);
procedure do_v_line (y : Line_Position;
x : Column_Position;
c : Attributed_Character;
to : Line_Position);
function padgetch (win : Window) return Key_Code;
function panner_legend (line : Line_Position) return Boolean;
procedure panner_legend (line : Line_Position);
procedure panner_h_cleanup (from_y : Line_Position;
from_x : Column_Position;
to_x : Column_Position);
procedure panner_v_cleanup (from_y : Line_Position;
from_x : Column_Position;
to_y : Line_Position);
procedure panner (pad : Window;
top_xp : Column_Position;
top_yp : Line_Position;
portyp : Line_Position;
portxp : Column_Position;
pgetc : myfunc);
function gettime return timestruct is
retval : timestruct;
use Interfaces.C;
type timeval is record
tv_sec : long;
tv_usec : long;
end record;
pragma Convention (C, timeval);
-- TODO function from_timeval is new Ada.Unchecked_Conversion(
-- timeval_a, System.Storage_Elements.Integer_Address);
-- should Interfaces.C.Pointers be used here?
package myP is new System.Address_To_Access_Conversions (timeval);
use myP;
t : constant Object_Pointer := new timeval;
function gettimeofday
(TP : System.Storage_Elements.Integer_Address;
TZP : System.Storage_Elements.Integer_Address) return int;
pragma Import (C, gettimeofday, "gettimeofday");
tmp : int;
begin
tmp := gettimeofday (System.Storage_Elements.To_Integer
(myP.To_Address (t)),
System.Storage_Elements.To_Integer
(myP.To_Address (null)));
if tmp < 0 then
retval.seconds := 0;
retval.microseconds := 0;
else
retval.seconds := Integer (t.tv_sec);
retval.microseconds := Integer (t.tv_usec);
end if;
return retval;
end gettime;
-- in C, The behavior of mvhline, mvvline for negative/zero length is
-- unspecified, though we can rely on negative x/y values to stop the
-- macro. Except Ada makes Line_Position(-1) = Natural - 1 so forget it.
procedure do_h_line (y : Line_Position;
x : Column_Position;
c : Attributed_Character;
to : Column_Position) is
begin
if to > x then
Move_Cursor (Line => y, Column => x);
Horizontal_Line (Line_Size => Natural (to - x), Line_Symbol => c);
end if;
end do_h_line;
procedure do_v_line (y : Line_Position;
x : Column_Position;
c : Attributed_Character;
to : Line_Position) is
begin
if to > y then
Move_Cursor (Line => y, Column => x);
Vertical_Line (Line_Size => Natural (to - y), Line_Symbol => c);
end if;
end do_v_line;
function padgetch (win : Window) return Key_Code is
c : Key_Code;
c2 : Character;
begin
c := Getchar (win);
c2 := Code_To_Char (c);
case c2 is
when '!' =>
ShellOut (False);
return Key_Refresh;
when Character'Val (Character'Pos ('r') mod 16#20#) => -- CTRL('r')
End_Windows;
Refresh;
return Key_Refresh;
when Character'Val (Character'Pos ('l') mod 16#20#) => -- CTRL('l')
return Key_Refresh;
when 'U' =>
return Key_Cursor_Up;
when 'D' =>
return Key_Cursor_Down;
when 'R' =>
return Key_Cursor_Right;
when 'L' =>
return Key_Cursor_Left;
when '+' =>
return Key_Insert_Line;
when '-' =>
return Key_Delete_Line;
when '>' =>
return Key_Insert_Char;
when '<' =>
return Key_Delete_Char;
-- when ERR=> /* FALLTHRU */
when 'q' =>
return (Key_Exit);
when others =>
return (c);
end case;
end padgetch;
show_panner_legend : Boolean := True;
function panner_legend (line : Line_Position) return Boolean is
legend : constant array (0 .. 3) of String (1 .. 61) :=
(
"Use arrow keys (or U,D,L,R) to pan, q to quit (?,t,s flags) ",
"Use ! to shell-out. Toggle legend:?, timer:t, scroll mark:s.",
"Use +,- (or j,k) to grow/shrink the panner vertically. ",
"Use <,> (or h,l) to grow/shrink the panner horizontally. ");
legendsize : constant := 4;
n : constant Integer := legendsize - Integer (Lines - line);
begin
if line < Lines and n >= 0 then
Move_Cursor (Line => line, Column => 0);
if show_panner_legend then
Add (Str => legend (n));
end if;
Clear_To_End_Of_Line;
return show_panner_legend;
end if;
return False;
end panner_legend;
procedure panner_legend (line : Line_Position) is
begin
if not panner_legend (line) then
Beep;
end if;
end panner_legend;
procedure panner_h_cleanup (from_y : Line_Position;
from_x : Column_Position;
to_x : Column_Position) is
begin
if not panner_legend (from_y) then
do_h_line (from_y, from_x, Blank2, to_x);
end if;
end panner_h_cleanup;
procedure panner_v_cleanup (from_y : Line_Position;
from_x : Column_Position;
to_y : Line_Position) is
begin
if not panner_legend (from_y) then
do_v_line (from_y, from_x, Blank2, to_y);
end if;
end panner_v_cleanup;
procedure panner (pad : Window;
top_xp : Column_Position;
top_yp : Line_Position;
portyp : Line_Position;
portxp : Column_Position;
pgetc : myfunc) is
function f (y : Line_Position) return Line_Position;
function f (x : Column_Position) return Column_Position;
function greater (y1, y2 : Line_Position) return Integer;
function greater (x1, x2 : Column_Position) return Integer;
top_x : Column_Position := top_xp;
top_y : Line_Position := top_yp;
porty : Line_Position := portyp;
portx : Column_Position := portxp;
-- f[x] returns max[x - 1, 0]
function f (y : Line_Position) return Line_Position is
begin
if y > 0 then
return y - 1;
else
return y; -- 0
end if;
end f;
function f (x : Column_Position) return Column_Position is
begin
if x > 0 then
return x - 1;
else
return x; -- 0
end if;
end f;
function greater (y1, y2 : Line_Position) return Integer is
begin
if y1 > y2 then
return 1;
else
return 0;
end if;
end greater;
function greater (x1, x2 : Column_Position) return Integer is
begin
if x1 > x2 then
return 1;
else
return 0;
end if;
end greater;
pymax : Line_Position;
basey : Line_Position := 0;
pxmax : Column_Position;
basex : Column_Position := 0;
c : Key_Code;
scrollers : Boolean := True;
before, after : timestruct;
timing : Boolean := True;
package floatio is new Ada.Text_IO.Float_IO (Long_Float);
begin
Get_Size (pad, pymax, pxmax);
Allow_Scrolling (Mode => False); -- we don't want stdscr to scroll!
c := Key_Refresh;
loop
-- During shell-out, the user may have resized the window. Adjust
-- the port size of the pad to accommodate this. Ncurses
-- automatically resizes all of the normal windows to fit on the
-- new screen.
if top_x > Columns then
top_x := Columns;
end if;
if portx > Columns then
portx := Columns;
end if;
if top_y > Lines then
top_y := Lines;
end if;
if porty > Lines then
porty := Lines;
end if;
case c is
when Key_Refresh | Character'Pos ('?') =>
if c = Key_Refresh then
Erase;
else -- '?'
show_panner_legend := not show_panner_legend;
end if;
panner_legend (Lines - 4);
panner_legend (Lines - 3);
panner_legend (Lines - 2);
panner_legend (Lines - 1);
when Character'Pos ('t') =>
timing := not timing;
if not timing then
panner_legend (Lines - 1);
end if;
when Character'Pos ('s') =>
scrollers := not scrollers;
-- Move the top-left corner of the pad, keeping the
-- bottom-right corner fixed.
when Character'Pos ('h') =>
-- increase-columns: move left edge to left
if top_x = 0 then
Beep;
else
panner_v_cleanup (top_y, top_x, porty);
top_x := top_x - 1;
end if;
when Character'Pos ('j') =>
-- decrease-lines: move top-edge down
if top_y >= porty then
Beep;
else
if top_y /= 0 then
panner_h_cleanup (top_y - 1, f (top_x), portx);
end if;
top_y := top_y + 1;
end if;
when Character'Pos ('k') =>
-- increase-lines: move top-edge up
if top_y = 0 then
Beep;
else
top_y := top_y - 1;
panner_h_cleanup (top_y, top_x, portx);
end if;
when Character'Pos ('l') =>
-- decrease-columns: move left-edge to right
if top_x >= portx then
Beep;
else
if top_x /= 0 then
panner_v_cleanup (f (top_y), top_x - 1, porty);
end if;
top_x := top_x + 1;
end if;
-- Move the bottom-right corner of the pad, keeping the
-- top-left corner fixed.
when Key_Insert_Char =>
-- increase-columns: move right-edge to right
if portx >= pxmax or portx >= Columns then
Beep;
else
panner_v_cleanup (f (top_y), portx - 1, porty);
portx := portx + 1;
-- C had ++portx instead of portx++, weird.
end if;
when Key_Insert_Line =>
-- increase-lines: move bottom-edge down
if porty >= pymax or porty >= Lines then
Beep;
else
panner_h_cleanup (porty - 1, f (top_x), portx);
porty := porty + 1;
end if;
when Key_Delete_Char =>
-- decrease-columns: move bottom edge up
if portx <= top_x then
Beep;
else
portx := portx - 1;
panner_v_cleanup (f (top_y), portx, porty);
end if;
when Key_Delete_Line =>
-- decrease-lines
if porty <= top_y then
Beep;
else
porty := porty - 1;
panner_h_cleanup (porty, f (top_x), portx);
end if;
when Key_Cursor_Left =>
-- pan leftwards
if basex > 0 then
basex := basex - 1;
else
Beep;
end if;
when Key_Cursor_Right =>
-- pan rightwards
-- if (basex + portx - (pymax > porty) < pxmax)
if basex + portx -
Column_Position (greater (pymax, porty)) < pxmax then
-- if basex + portx < pxmax or
-- (pymax > porty and basex + portx - 1 < pxmax) then
basex := basex + 1;
else
Beep;
end if;
when Key_Cursor_Up =>
-- pan upwards
if basey > 0 then
basey := basey - 1;
else
Beep;
end if;
when Key_Cursor_Down =>
-- pan downwards
-- same as if (basey + porty - (pxmax > portx) < pymax)
if basey + porty -
Line_Position (greater (pxmax, portx)) < pymax then
-- if (basey + porty < pymax) or
-- (pxmax > portx and basey + porty - 1 < pymax) then
basey := basey + 1;
else
Beep;
end if;
when Character'Pos ('H') |
Key_Home |
Key_Find =>
basey := 0;
when Character'Pos ('E') |
Key_End |
Key_Select =>
if pymax < porty then
basey := 0;
else
basey := pymax - porty;
end if;
when others =>
Beep;
end case;
-- more writing off the screen.
-- Interestingly, the exception is not handled if
-- we put a block around this.
-- delcare --begin
if top_y /= 0 and top_x /= 0 then
Add (Line => top_y - 1, Column => top_x - 1,
Ch => ACS_Map (ACS_Upper_Left_Corner));
end if;
if top_x /= 0 then
do_v_line (top_y, top_x - 1, ACS_Map (ACS_Vertical_Line), porty);
end if;
if top_y /= 0 then
do_h_line (top_y - 1, top_x, ACS_Map (ACS_Horizontal_Line), portx);
end if;
-- exception when Curses_Exception => null; end;
-- in C was ... pxmax > portx - 1
if scrollers and pxmax >= portx then
declare
length : constant Column_Position := portx - top_x - 1;
lowend, highend : Column_Position;
begin
-- Instead of using floats, I'll use integers only.
lowend := top_x + (basex * length) / pxmax;
highend := top_x + ((basex + length) * length) / pxmax;
do_h_line (porty - 1, top_x, ACS_Map (ACS_Horizontal_Line),
lowend);
if highend < portx then
Switch_Character_Attribute
(Attr => (Reverse_Video => True, others => False),
On => True);
do_h_line (porty - 1, lowend, Blank2, highend + 1);
Switch_Character_Attribute
(Attr => (Reverse_Video => True, others => False),
On => False);
do_h_line (porty - 1, highend + 1,
ACS_Map (ACS_Horizontal_Line), portx);
end if;
end;
else
do_h_line (porty - 1, top_x, ACS_Map (ACS_Horizontal_Line), portx);
end if;
if scrollers and pymax >= porty then
declare
length : constant Line_Position := porty - top_y - 1;
lowend, highend : Line_Position;
begin
lowend := top_y + (basey * length) / pymax;
highend := top_y + ((basey + length) * length) / pymax;
do_v_line (top_y, portx - 1, ACS_Map (ACS_Vertical_Line),
lowend);
if highend < porty then
Switch_Character_Attribute
(Attr => (Reverse_Video => True, others => False),
On => True);
do_v_line (lowend, portx - 1, Blank2, highend + 1);
Switch_Character_Attribute
(Attr => (Reverse_Video => True, others => False),
On => False);
do_v_line (highend + 1, portx - 1,
ACS_Map (ACS_Vertical_Line), porty);
end if;
end;
else
do_v_line (top_y, portx - 1, ACS_Map (ACS_Vertical_Line), porty);
end if;
if top_y /= 0 then
Add (Line => top_y - 1, Column => portx - 1,
Ch => ACS_Map (ACS_Upper_Right_Corner));
end if;
if top_x /= 0 then
Add (Line => porty - 1, Column => top_x - 1,
Ch => ACS_Map (ACS_Lower_Left_Corner));
end if;
declare
begin
-- Here is another place where it is possible
-- to write to the corner of the screen.
Add (Line => porty - 1, Column => portx - 1,
Ch => ACS_Map (ACS_Lower_Right_Corner));
exception
when Curses_Exception => null;
end;
before := gettime;
Refresh_Without_Update;
declare
-- the C version allows the panel to have a zero height
-- wich raise the exception
begin
Refresh_Without_Update
(
pad,
basey, basex,
top_y, top_x,
porty - Line_Position (greater (pxmax, portx)) - 1,
portx - Column_Position (greater (pymax, porty)) - 1);
exception
when Curses_Exception => null;
end;
Update_Screen;
if timing then
declare
s : String (1 .. 7);
elapsed : Long_Float;
begin
after := gettime;
elapsed := (Long_Float (after.seconds - before.seconds) +
Long_Float (after.microseconds
- before.microseconds)
/ 1.0e6);
Move_Cursor (Line => Lines - 1, Column => Columns - 20);
floatio.Put (s, elapsed, Aft => 3, Exp => 0);
Add (Str => s);
Refresh;
end;
end if;
c := pgetc (pad);
exit when c = Key_Exit;
end loop;
Allow_Scrolling (Mode => True);
end panner;
Gridsize : constant := 3;
Gridcount : Integer := 0;
Pad_High : constant Line_Count := 200;
Pad_Wide : constant Column_Count := 200;
panpad : Window := New_Pad (Pad_High, Pad_Wide);
begin
if panpad = Null_Window then
Cannot ("cannot create requested pad");
return;
end if;
for i in 0 .. Pad_High - 1 loop
for j in 0 .. Pad_Wide - 1 loop
if i mod Gridsize = 0 and j mod Gridsize = 0 then
if i = 0 or j = 0 then
Add (panpad, '+');
else
-- depends on ASCII?
Add (panpad,
Ch => Character'Val (Character'Pos ('A') +
Gridcount mod 26));
Gridcount := Gridcount + 1;
end if;
elsif i mod Gridsize = 0 then
Add (panpad, '-');
elsif j mod Gridsize = 0 then
Add (panpad, '|');
else
declare
-- handle the write to the lower right corner error
begin
Add (panpad, ' ');
exception
when Curses_Exception => null;
end;
end if;
end loop;
end loop;
panner_legend (Lines - 4);
panner_legend (Lines - 3);
panner_legend (Lines - 2);
panner_legend (Lines - 1);
Set_KeyPad_Mode (panpad, True);
-- Make the pad (initially) narrow enough that a trace file won't wrap.
-- We'll still be able to widen it during a test, since that's required
-- for testing boundaries.
panner (panpad, 2, 2, Lines - 5, Columns - 15, padgetch'Access);
Delete (panpad);
End_Windows; -- Hmm, Erase after End_Windows
Erase;
end ncurses2.demo_pad;

41
Ada95/samples/ncurses2-demo_pad.ads Normal file
View File

@ -0,0 +1,41 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
procedure ncurses2.demo_pad;

382
Ada95/samples/ncurses2-demo_panels.adb Normal file
View File

@ -0,0 +1,382 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000-2004,2008 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.6 $
-- $Date: 2008/08/30 23:35:01 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with ncurses2.util; use ncurses2.util;
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
with Terminal_Interface.Curses.Panels.User_Data;
with ncurses2.genericPuts;
procedure ncurses2.demo_panels (nap_mseci : Integer) is
use Int_IO;
function mkpanel (color : Color_Number;
rows : Line_Count;
cols : Column_Count;
tly : Line_Position;
tlx : Column_Position) return Panel;
procedure rmpanel (pan : in out Panel);
procedure pflush;
procedure wait_a_while (msec : Integer);
procedure saywhat (text : String);
procedure fill_panel (pan : Panel);
nap_msec : Integer := nap_mseci;
function mkpanel (color : Color_Number;
rows : Line_Count;
cols : Column_Count;
tly : Line_Position;
tlx : Column_Position) return Panel is
win : Window;
pan : Panel := Null_Panel;
begin
win := New_Window (rows, cols, tly, tlx);
if Null_Window /= win then
pan := New_Panel (win);
if pan = Null_Panel then
Delete (win);
elsif Has_Colors then
declare
fg, bg : Color_Number;
begin
if color = Blue then
fg := White;
else
fg := Black;
end if;
bg := color;
Init_Pair (Color_Pair (color), fg, bg);
Set_Background (win, (Ch => ' ',
Attr => Normal_Video,
Color => Color_Pair (color)));
end;
else
Set_Background (win, (Ch => ' ',
Attr => (Bold_Character => True,
others => False),
Color => Color_Pair (color)));
end if;
end if;
return pan;
end mkpanel;
procedure rmpanel (pan : in out Panel) is
win : Window := Panel_Window (pan);
begin
Delete (pan);
Delete (win);
end rmpanel;
procedure pflush is
begin
Update_Panels;
Update_Screen;
end pflush;
procedure wait_a_while (msec : Integer) is
begin
-- The C version had some #ifdef blocks here
if msec = 1 then
Getchar;
else
Nap_Milli_Seconds (msec);
end if;
end wait_a_while;
procedure saywhat (text : String) is
begin
Move_Cursor (Line => Lines - 1, Column => 0);
Clear_To_End_Of_Line;
Add (Str => text);
end saywhat;
-- from sample-curses_demo.adb
type User_Data is new String (1 .. 2);
type User_Data_Access is access all User_Data;
package PUD is new Panels.User_Data (User_Data, User_Data_Access);
use PUD;
procedure fill_panel (pan : Panel) is
win : constant Window := Panel_Window (pan);
num : constant Character := Get_User_Data (pan) (2);
tmp6 : String (1 .. 6) := "-panx-";
maxy : Line_Count;
maxx : Column_Count;
begin
Move_Cursor (win, 1, 1);
tmp6 (5) := num;
Add (win, Str => tmp6);
Clear_To_End_Of_Line (win);
Box (win);
Get_Size (win, maxy, maxx);
for y in 2 .. maxy - 3 loop
for x in 1 .. maxx - 3 loop
Move_Cursor (win, y, x);
Add (win, num);
end loop;
end loop;
exception
when Curses_Exception => null;
end fill_panel;
modstr : constant array (0 .. 5) of String (1 .. 5) :=
("test ",
"TEST ",
"(**) ",
"*()* ",
"<--> ",
"LAST "
);
package p is new ncurses2.genericPuts (1024);
use p;
use p.BS;
-- the C version said register int y, x;
tmpb : BS.Bounded_String;
begin
Refresh;
for y in 0 .. Integer (Lines - 2) loop
for x in 0 .. Integer (Columns - 1) loop
myPut (tmpb, (y + x) mod 10);
myAdd (Str => tmpb);
end loop;
end loop;
for y in 0 .. 4 loop
declare
p1, p2, p3, p4, p5 : Panel;
U1 : constant User_Data_Access := new User_Data'("p1");
U2 : constant User_Data_Access := new User_Data'("p2");
U3 : constant User_Data_Access := new User_Data'("p3");
U4 : constant User_Data_Access := new User_Data'("p4");
U5 : constant User_Data_Access := new User_Data'("p5");
begin
p1 := mkpanel (Red, Lines / 2 - 2, Columns / 8 + 1, 0, 0);
Set_User_Data (p1, U1);
p2 := mkpanel (Green, Lines / 2 + 1, Columns / 7, Lines / 4,
Columns / 10);
Set_User_Data (p2, U2);
p3 := mkpanel (Yellow, Lines / 4, Columns / 10, Lines / 2,
Columns / 9);
Set_User_Data (p3, U3);
p4 := mkpanel (Blue, Lines / 2 - 2, Columns / 8, Lines / 2 - 2,
Columns / 3);
Set_User_Data (p4, U4);
p5 := mkpanel (Magenta, Lines / 2 - 2, Columns / 8, Lines / 2,
Columns / 2 - 2);
Set_User_Data (p5, U5);
fill_panel (p1);
fill_panel (p2);
fill_panel (p3);
fill_panel (p4);
fill_panel (p5);
Hide (p4);
Hide (p5);
pflush;
saywhat ("press any key to continue");
wait_a_while (nap_msec);
saywhat ("h3 s1 s2 s4 s5; press any key to continue");
Move (p1, 0, 0);
Hide (p3);
Show (p1);
Show (p2);
Show (p4);
Show (p5);
pflush;
wait_a_while (nap_msec);
saywhat ("s1; press any key to continue");
Show (p1);
pflush;
wait_a_while (nap_msec);
saywhat ("s2; press any key to continue");
Show (p2);
pflush;
wait_a_while (nap_msec);
saywhat ("m2; press any key to continue");
Move (p2, Lines / 3 + 1, Columns / 8);
pflush;
wait_a_while (nap_msec);
saywhat ("s3;");
Show (p3);
pflush;
wait_a_while (nap_msec);
saywhat ("m3; press any key to continue");
Move (p3, Lines / 4 + 1, Columns / 15);
pflush;
wait_a_while (nap_msec);
saywhat ("b3; press any key to continue");
Bottom (p3);
pflush;
wait_a_while (nap_msec);
saywhat ("s4; press any key to continue");
Show (p4);
pflush;
wait_a_while (nap_msec);
saywhat ("s5; press any key to continue");
Show (p5);
pflush;
wait_a_while (nap_msec);
saywhat ("t3; press any key to continue");
Top (p3);
pflush;
wait_a_while (nap_msec);
saywhat ("t1; press any key to continue");
Top (p1);
pflush;
wait_a_while (nap_msec);
saywhat ("t2; press any key to continue");
Top (p2);
pflush;
wait_a_while (nap_msec);
saywhat ("t3; press any key to continue");
Top (p3);
pflush;
wait_a_while (nap_msec);
saywhat ("t4; press any key to continue");
Top (p4);
pflush;
wait_a_while (nap_msec);
for itmp in 0 .. 5 loop
declare
w4 : constant Window := Panel_Window (p4);
w5 : constant Window := Panel_Window (p5);
begin
saywhat ("m4; press any key to continue");
Move_Cursor (w4, Lines / 8, 1);
Add (w4, modstr (itmp));
Move (p4, Lines / 6, Column_Position (itmp) * (Columns / 8));
Move_Cursor (w5, Lines / 6, 1);
Add (w5, modstr (itmp));
pflush;
wait_a_while (nap_msec);
saywhat ("m5; press any key to continue");
Move_Cursor (w4, Lines / 6, 1);
Add (w4, modstr (itmp));
Move (p5, Lines / 3 - 1, (Column_Position (itmp) * 10) + 6);
Move_Cursor (w5, Lines / 8, 1);
Add (w5, modstr (itmp));
pflush;
wait_a_while (nap_msec);
end;
end loop;
saywhat ("m4; press any key to continue");
Move (p4, Lines / 6, 6 * (Columns / 8));
-- Move(p4, Lines / 6, itmp * (Columns / 8));
pflush;
wait_a_while (nap_msec);
saywhat ("t5; press any key to continue");
Top (p5);
pflush;
wait_a_while (nap_msec);
saywhat ("t2; press any key to continue");
Top (p2);
pflush;
wait_a_while (nap_msec);
saywhat ("t1; press any key to continue");
Top (p1);
pflush;
wait_a_while (nap_msec);
saywhat ("d2; press any key to continue");
rmpanel (p2);
pflush;
wait_a_while (nap_msec);
saywhat ("h3; press any key to continue");
Hide (p3);
pflush;
wait_a_while (nap_msec);
saywhat ("d1; press any key to continue");
rmpanel (p1);
pflush;
wait_a_while (nap_msec);
saywhat ("d4; press any key to continue");
rmpanel (p4);
pflush;
wait_a_while (nap_msec);
saywhat ("d5; press any key to continue");
rmpanel (p5);
pflush;
wait_a_while (nap_msec);
if nap_msec = 1 then
exit;
else
nap_msec := 100;
end if;
end;
end loop;
Erase;
End_Windows;
end ncurses2.demo_panels;

41
Ada95/samples/ncurses2-demo_panels.ads Normal file
View File

@ -0,0 +1,41 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
procedure ncurses2.demo_panels (nap_mseci : Integer);

135
Ada95/samples/ncurses2-flushinp_test.adb Normal file
View File

@ -0,0 +1,135 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with ncurses2.util; use ncurses2.util;
procedure ncurses2.flushinp_test (win : Window) is
procedure Continue (win : Window);
procedure Continue (win : Window) is
begin
Set_Echo_Mode (False);
Move_Cursor (win, 10, 1);
Add (win, 10, 1, " Press any key to continue");
Refresh (win);
Getchar (win);
end Continue;
h, by, sh : Line_Position;
w, bx, sw : Column_Position;
subWin : Window;
begin
Clear (win);
Get_Size (win, h, w);
Get_Window_Position (win, by, bx);
sw := w / 3;
sh := h / 3;
subWin := Sub_Window (win, sh, sw, by + h - sh - 2, bx + w - sw - 2);
if Has_Colors then
Init_Pair (2, Cyan, Blue);
Change_Background (subWin,
Attributed_Character'(Ch => ' ', Color => 2,
Attr => Normal_Video));
end if;
Set_Character_Attributes (subWin,
(Bold_Character => True, others => False));
Box (subWin);
Add (subWin, 2, 1, "This is a subwindow");
Refresh (win);
Set_Cbreak_Mode (True);
Add (win, 0, 1, "This is a test of the flushinp() call.");
Add (win, 2, 1, "Type random keys for 5 seconds.");
Add (win, 3, 1,
"These should be discarded (not echoed) after the subwindow " &
"goes away.");
Refresh (win);
for i in 0 .. 4 loop
Move_Cursor (subWin, 1, 1);
Add (subWin, Str => "Time = ");
Add (subWin, Str => Integer'Image (i));
Refresh (subWin);
Nap_Milli_Seconds (1000);
Flush_Input;
end loop;
Delete (subWin);
Erase (win);
Flash_Screen;
Refresh (win);
Nap_Milli_Seconds (1000);
Add (win, 2, 1,
Str => "If you were still typing when the window timer expired,");
Add (win, 3, 1,
"or else you typed nothing at all while it was running,");
Add (win, 4, 1,
"test was invalid. You'll see garbage or nothing at all. ");
Add (win, 6, 1, "Press a key");
Move_Cursor (win, 9, 10);
Refresh (win);
Set_Echo_Mode (True);
Getchar (win);
Flush_Input;
Add (win, 12, 0,
"If you see any key other than what you typed, flushinp() is broken.");
Continue (win);
Move_Cursor (win, 9, 10);
Delete_Character (win);
Refresh (win);
Move_Cursor (win, 12, 0);
Clear_To_End_Of_Line;
Add (win,
"What you typed should now have been deleted; if not, wdelch() " &
"failed.");
Continue (win);
Set_Cbreak_Mode (True);
end ncurses2.flushinp_test;

43
Ada95/samples/ncurses2-flushinp_test.ads Normal file
View File

@ -0,0 +1,43 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses;
procedure ncurses2.flushinp_test (win : Terminal_Interface.Curses.Window);

117
Ada95/samples/ncurses2-genericputs.adb Normal file
View File

@ -0,0 +1,117 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000-2008,2009 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.4 $
-- $Date: 2009/12/26 17:38:58 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
package body ncurses2.genericPuts is
procedure myGet (Win : Window := Standard_Window;
Str : out BS.Bounded_String;
Len : Integer := -1)
is
function Wgetnstr (Win : Window;
Str : char_array;
Len : int) return int;
pragma Import (C, Wgetnstr, "wgetnstr");
N : Integer := Len;
Txt : char_array (0 .. size_t (Max_Length));
xStr : String (1 .. Max_Length);
Cnt : Natural;
begin
if N < 0 then
N := Max_Length;
end if;
if N > Max_Length then
raise Constraint_Error;
end if;
Txt (0) := Interfaces.C.char'First;
if Wgetnstr (Win, Txt, C_Int (N)) = Curses_Err then
raise Curses_Exception;
end if;
To_Ada (Txt, xStr, Cnt, True);
Str := To_Bounded_String (xStr (1 .. Cnt));
end myGet;
procedure myPut (Str : out BS.Bounded_String;
i : Integer;
Base : Number_Base := 10) is
package Int_IO is new Integer_IO (Integer); use Int_IO;
tmp : String (1 .. BS.Max_Length);
begin
Put (tmp, i, Base);
Str := To_Bounded_String (tmp);
Trim (Str, Ada.Strings.Trim_End'(Ada.Strings.Left));
end myPut;
procedure myAdd (Str : BS.Bounded_String) is
begin
Add (Str => To_String (Str));
end myAdd;
-- from ncurses-aux
procedure Fill_String (Cp : chars_ptr;
Str : out BS.Bounded_String)
is
-- Fill the string with the characters referenced by the
-- chars_ptr.
--
Len : Natural;
begin
if Cp /= Null_Ptr then
Len := Natural (Strlen (Cp));
if Max_Length < Len then
raise Constraint_Error;
end if;
declare
S : String (1 .. Len);
begin
S := Value (Cp);
Str := To_Bounded_String (S);
end;
else
Str := Null_Bounded_String;
end if;
end Fill_String;
end ncurses2.genericPuts;

72
Ada95/samples/ncurses2-genericputs.ads Normal file
View File

@ -0,0 +1,72 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000-2006,2009 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.3 $
-- $Date: 2009/12/26 17:38:58 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Strings.Bounded;
use Ada.Strings.Bounded;
with Interfaces.C; use Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;
with Terminal_Interface.Curses;
generic
Max : Natural;
-- type mystring is private;
-- type myint is
package ncurses2.genericPuts is
package BS is new
Ada.Strings.Bounded.Generic_Bounded_Length (Max);
use BS;
procedure myGet (Win : Terminal_Interface.Curses.Window
:= Terminal_Interface.Curses.Standard_Window;
Str : out BS.Bounded_String;
Len : Integer := -1);
procedure myPut (Str : out BS.Bounded_String;
i : Integer;
Base : Number_Base := 10);
-- the default should be Ada.Text_IO.Integer_IO.Default_Base
-- but Default_Base is hidden in the generic so doesn't exist!
procedure myAdd (Str : BS.Bounded_String);
procedure Fill_String (Cp : chars_ptr; Str : out BS.Bounded_String);
end ncurses2.genericPuts;

41
Ada95/samples/ncurses2-getch.ads Normal file
View File

@ -0,0 +1,41 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
procedure getch_test;

254
Ada95/samples/ncurses2-getch_test.adb Normal file
View File

@ -0,0 +1,254 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000-2008,2009 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.8 $
-- $Date: 2009/12/26 17:38:58 $
-- Binding Version 01.00
------------------------------------------------------------------------------
-- Character input test
-- test the keypad feature
with ncurses2.util; use ncurses2.util;
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
with Ada.Characters.Handling;
with Ada.Strings.Bounded;
with ncurses2.genericPuts;
procedure ncurses2.getch_test is
use Int_IO;
function mouse_decode (ep : Mouse_Event) return String;
function mouse_decode (ep : Mouse_Event) return String is
Y : Line_Position;
X : Column_Position;
Button : Mouse_Button;
State : Button_State;
package BS is new Ada.Strings.Bounded.Generic_Bounded_Length (200);
use BS;
buf : Bounded_String := To_Bounded_String ("");
begin
-- Note that these bindings do not allow
-- two button states,
-- The C version can print {click-1, click-3} for example.
-- They also don't have the 'id' or z coordinate.
Get_Event (ep, Y, X, Button, State);
-- TODO Append (buf, "id "); from C version
Append (buf, "at (");
Append (buf, Column_Position'Image (X));
Append (buf, ", ");
Append (buf, Line_Position'Image (Y));
Append (buf, ") state");
Append (buf, Mouse_Button'Image (Button));
Append (buf, " = ");
Append (buf, Button_State'Image (State));
return To_String (buf);
end mouse_decode;
buf : String (1 .. 1024); -- TODO was BUFSIZE
n : Integer;
c : Key_Code;
blockflag : Timeout_Mode := Blocking;
firsttime : Boolean := True;
tmp2 : Event_Mask;
tmp6 : String (1 .. 6);
tmp20 : String (1 .. 20);
x : Column_Position;
y : Line_Position;
tmpx : Integer;
incount : Integer := 0;
begin
Refresh;
tmp2 := Start_Mouse (All_Events);
Add (Str => "Delay in 10ths of a second (<CR> for blocking input)? ");
Set_Echo_Mode (SwitchOn => True);
Get (Str => buf);
Set_Echo_Mode (SwitchOn => False);
Set_NL_Mode (SwitchOn => False);
if Ada.Characters.Handling.Is_Digit (buf (1)) then
Get (Item => n, From => buf, Last => tmpx);
Set_Timeout_Mode (Mode => Delayed, Amount => n * 100);
blockflag := Delayed;
end if;
c := Character'Pos ('?');
Set_Raw_Mode (SwitchOn => True);
loop
if not firsttime then
Add (Str => "Key pressed: ");
Put (tmp6, Integer (c), 8);
Add (Str => tmp6);
Add (Ch => ' ');
if c = Key_Mouse then
declare
event : Mouse_Event;
begin
event := Get_Mouse;
Add (Str => "KEY_MOUSE, ");
Add (Str => mouse_decode (event));
Add (Ch => newl);
end;
elsif c >= Key_Min then
Key_Name (c, tmp20);
Add (Str => tmp20);
-- I used tmp and got bitten by the length problem:->
Add (Ch => newl);
elsif c > 16#80# then -- TODO fix, use constant if possible
declare
c2 : constant Character := Character'Val (c mod 16#80#);
begin
if Ada.Characters.Handling.Is_Graphic (c2) then
Add (Str => "M-");
Add (Ch => c2);
else
Add (Str => "M-");
Add (Str => Un_Control ((Ch => c2,
Color => Color_Pair'First,
Attr => Normal_Video)));
end if;
Add (Str => " (high-half character)");
Add (Ch => newl);
end;
else
declare
c2 : constant Character := Character'Val (c mod 16#80#);
begin
if Ada.Characters.Handling.Is_Graphic (c2) then
Add (Ch => c2);
Add (Str => " (ASCII printable character)");
Add (Ch => newl);
else
Add (Str => Un_Control ((Ch => c2,
Color => Color_Pair'First,
Attr => Normal_Video)));
Add (Str => " (ASCII control character)");
Add (Ch => newl);
end if;
end;
end if;
-- TODO I am not sure why this was in the C version
-- the delay statement scroll anyway.
Get_Cursor_Position (Line => y, Column => x);
if y >= Lines - 1 then
Move_Cursor (Line => 0, Column => 0);
end if;
Clear_To_End_Of_Line;
end if;
firsttime := False;
if c = Character'Pos ('g') then
declare
package p is new ncurses2.genericPuts (1024);
use p;
use p.BS;
timedout : Boolean := False;
boundedbuf : Bounded_String;
begin
Add (Str => "getstr test: ");
Set_Echo_Mode (SwitchOn => True);
-- Note that if delay mode is set
-- Get can raise an exception.
-- The C version would print the string it had so far
-- also TODO get longer length string, like the C version
declare begin
myGet (Str => boundedbuf);
exception when Curses_Exception =>
Add (Str => "Timed out.");
Add (Ch => newl);
timedout := True;
end;
-- note that the Ada Get will stop reading at 1024.
if not timedout then
Set_Echo_Mode (SwitchOn => False);
Add (Str => " I saw '");
myAdd (Str => boundedbuf);
Add (Str => "'.");
Add (Ch => newl);
end if;
end;
elsif c = Character'Pos ('s') then
ShellOut (True);
elsif c = Character'Pos ('x') or c = Character'Pos ('q') or
(c = Key_None and blockflag = Blocking) then
exit;
elsif c = Character'Pos ('?') then
Add (Str => "Type any key to see its keypad value. Also:");
Add (Ch => newl);
Add (Str => "g -- triggers a getstr test");
Add (Ch => newl);
Add (Str => "s -- shell out");
Add (Ch => newl);
Add (Str => "q -- quit");
Add (Ch => newl);
Add (Str => "? -- repeats this help message");
Add (Ch => newl);
end if;
loop
c := Getchar;
exit when c /= Key_None;
if blockflag /= Blocking then
Put (tmp6, incount); -- argh string length!
Add (Str => tmp6);
Add (Str => ": input timed out");
Add (Ch => newl);
else
Put (tmp6, incount);
Add (Str => tmp6);
Add (Str => ": input error");
Add (Ch => newl);
exit;
end if;
incount := incount + 1;
end loop;
end loop;
End_Mouse (tmp2);
Set_Timeout_Mode (Mode => Blocking, Amount => 0); -- amount is ignored
Set_Raw_Mode (SwitchOn => False);
Set_NL_Mode (SwitchOn => True);
Erase;
End_Windows;
end ncurses2.getch_test;

41
Ada95/samples/ncurses2-getch_test.ads Normal file
View File

@ -0,0 +1,41 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
procedure ncurses2.getch_test;

163
Ada95/samples/ncurses2-getopt.adb Normal file
View File

@ -0,0 +1,163 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000-2004,2008 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.7 $
-- $Date: 2008/07/26 18:46:44 $
-- Binding Version 01.00
------------------------------------------------------------------------------
-- A simplified version of the GNU getopt function
-- copyright Free Software Foundtion
with Ada.Strings.Fixed;
with Ada.Strings.Bounded;
with Ada.Text_IO; use Ada.Text_IO;
package body ncurses2.getopt is
nextchar : Natural := 0;
-- Ncurses doesn't use the non option elements so we are spared
-- the job of computing those.
-- also the user is not allowed to modify argv or argc
-- Doing so is Erroneous execution.
-- longoptions are not handled.
procedure Qgetopt (retval : out Integer;
argc : Integer;
argv : stringfunc;
-- argv will be the Argument function.
optstring : String;
optind : in out Integer;
-- ignored for ncurses, must be initialized to 1 by
-- the caller
Optarg : out stringa
-- a garbage colector would be useful here.
) is
package BS is new Ada.Strings.Bounded.Generic_Bounded_Length (200);
use BS;
optargx : Bounded_String;
begin
if argc < optind then
retval := -1;
return;
end if;
optargx := To_Bounded_String ("");
if nextchar = 0 then
if argv (optind) = "--" then
-- the rest are non-options, we ignore them
retval := -1;
return;
end if;
if argv (optind)(1) /= '-' or argv (optind)'Length = 1 then
optind := optind + 1;
Optarg := new String'(argv (optind));
retval := 1;
return;
end if;
nextchar := 2; -- skip the one hyphen.
end if;
-- Look at and handle the next short option-character.
declare
c : Character := argv (optind) (nextchar);
temp : constant Natural :=
Ada.Strings.Fixed.Index (optstring, String'(1 => c));
begin
if temp = 0 or c = ':' then
Put_Line (Standard_Error,
argv (optind) & ": invalid option -- " & c);
c := '?';
return;
end if;
if optstring (temp + 1) = ':' then
if optstring (temp + 2) = ':' then
-- This is an option that accepts an argument optionally.
if nextchar /= argv (optind)'Length then
optargx := To_Bounded_String
(argv (optind) (nextchar .. argv (optind)'Length));
else
Optarg := null;
end if;
else
-- This is an option that requires an argument.
if nextchar /= argv (optind)'Length then
optargx := To_Bounded_String
(argv (optind) (nextchar .. argv (optind)'Length));
optind := optind + 1;
elsif optind = argc then
Put_Line (Standard_Error,
argv (optind) &
": option requires an argument -- " & c);
if optstring (optstring'First) = ':' then
c := ':';
else
c := '?';
end if;
else
-- increment it again when taking next ARGV-elt as argument.
optind := optind + 1;
optargx := To_Bounded_String (argv (optind));
optind := optind + 1;
end if;
end if;
nextchar := 0;
else -- no argument for the option
if nextchar = argv (optind)'Length then
optind := optind + 1;
nextchar := 0;
else
nextchar := nextchar + 1;
end if;
end if;
retval := Character'Pos (c);
Optarg := new String'(To_String (optargx));
return;
end;
end Qgetopt;
end ncurses2.getopt;

60
Ada95/samples/ncurses2-getopt.ads Normal file
View File

@ -0,0 +1,60 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000,2006 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.2 $
-- $Date: 2006/06/25 14:24:40 $
-- Binding Version 01.00
------------------------------------------------------------------------------
package ncurses2.getopt is
type stringa is access String;
type stringfunc is access
function (n : Positive) return String;
procedure Qgetopt (retval : out Integer;
argc : Integer;
argv : stringfunc;
optstring : String;
optind : in out Integer;
-- ignored for ncurses, must be initialized to 0
-- by the caller
Optarg : out stringa
-- a garbage collector would be useful here.
);
end ncurses2.getopt;

448
Ada95/samples/ncurses2-m.adb Normal file
View File

@ -0,0 +1,448 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000-2006,2008 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.8 $
-- $Date: 2008/07/26 18:47:50 $
-- Binding Version 01.00
------------------------------------------------------------------------------
-- TODO use Default_Character where appropriate
-- This is an Ada version of ncurses
-- I translated this because it tests the most features.
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Terminal_Interface.Curses.Trace; use Terminal_Interface.Curses.Trace;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Characters.Latin_1;
-- with Ada.Characters.Handling;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Strings.Unbounded;
with ncurses2.util; use ncurses2.util;
with ncurses2.getch_test;
with ncurses2.attr_test;
with ncurses2.color_test;
with ncurses2.demo_panels;
with ncurses2.color_edit;
with ncurses2.slk_test;
with ncurses2.acs_display;
with ncurses2.acs_and_scroll;
with ncurses2.flushinp_test;
with ncurses2.test_sgr_attributes;
with ncurses2.menu_test;
with ncurses2.demo_pad;
with ncurses2.demo_forms;
with ncurses2.overlap_test;
with ncurses2.trace_set;
with ncurses2.getopt; use ncurses2.getopt;
package body ncurses2.m is
use Int_IO;
function To_trace (n : Integer) return Trace_Attribute_Set;
procedure usage;
procedure Set_Terminal_Modes;
function Do_Single_Test (c : Character) return Boolean;
function To_trace (n : Integer) return Trace_Attribute_Set is
a : Trace_Attribute_Set := (others => False);
m : Integer;
rest : Integer;
begin
m := n mod 2;
if 1 = m then
a.Times := True;
end if;
rest := n / 2;
m := rest mod 2;
if 1 = m then
a.Tputs := True;
end if;
rest := rest / 2;
m := rest mod 2;
if 1 = m then
a.Update := True;
end if;
rest := rest / 2;
m := rest mod 2;
if 1 = m then
a.Cursor_Move := True;
end if;
rest := rest / 2;
m := rest mod 2;
if 1 = m then
a.Character_Output := True;
end if;
rest := rest / 2;
m := rest mod 2;
if 1 = m then
a.Calls := True;
end if;
rest := rest / 2;
m := rest mod 2;
if 1 = m then
a.Virtual_Puts := True;
end if;
rest := rest / 2;
m := rest mod 2;
if 1 = m then
a.Input_Events := True;
end if;
rest := rest / 2;
m := rest mod 2;
if 1 = m then
a.TTY_State := True;
end if;
rest := rest / 2;
m := rest mod 2;
if 1 = m then
a.Internal_Calls := True;
end if;
rest := rest / 2;
m := rest mod 2;
if 1 = m then
a.Character_Calls := True;
end if;
rest := rest / 2;
m := rest mod 2;
if 1 = m then
a.Termcap_TermInfo := True;
end if;
return a;
end To_trace;
-- these are type Stdscr_Init_Proc;
function rip_footer (
Win : Window;
Columns : Column_Count) return Integer;
pragma Convention (C, rip_footer);
function rip_footer (
Win : Window;
Columns : Column_Count) return Integer is
begin
Set_Background (Win, (Ch => ' ',
Attr => (Reverse_Video => True, others => False),
Color => 0));
Erase (Win);
Move_Cursor (Win, 0, 0);
Add (Win, "footer:" & Columns'Img & " columns");
Refresh_Without_Update (Win);
return 0; -- Curses_OK;
end rip_footer;
function rip_header (
Win : Window;
Columns : Column_Count) return Integer;
pragma Convention (C, rip_header);
function rip_header (
Win : Window;
Columns : Column_Count) return Integer is
begin
Set_Background (Win, (Ch => ' ',
Attr => (Reverse_Video => True, others => False),
Color => 0));
Erase (Win);
Move_Cursor (Win, 0, 0);
Add (Win, "header:" & Columns'Img & " columns");
-- 'Img is a GNAT extention
Refresh_Without_Update (Win);
return 0; -- Curses_OK;
end rip_header;
procedure usage is
-- type Stringa is access String;
use Ada.Strings.Unbounded;
-- tbl : constant array (Positive range <>) of Stringa := (
tbl : constant array (Positive range <>) of Unbounded_String
:= (
To_Unbounded_String ("Usage: ncurses [options]"),
To_Unbounded_String (""),
To_Unbounded_String ("Options:"),
To_Unbounded_String (" -a f,b set default-colors " &
"(assumed white-on-black)"),
To_Unbounded_String (" -d use default-colors if terminal " &
"supports them"),
To_Unbounded_String (" -e fmt specify format for soft-keys " &
"test (e)"),
To_Unbounded_String (" -f rip-off footer line " &
"(can repeat)"),
To_Unbounded_String (" -h rip-off header line " &
"(can repeat)"),
To_Unbounded_String (" -s msec specify nominal time for " &
"panel-demo (default: 1, to hold)"),
To_Unbounded_String (" -t mask specify default trace-level " &
"(may toggle with ^T)")
);
begin
for n in tbl'Range loop
Put_Line (Standard_Error, To_String (tbl (n)));
end loop;
-- exit(EXIT_FAILURE);
-- TODO should we use Set_Exit_Status and throw and exception?
end usage;
procedure Set_Terminal_Modes is begin
Set_Raw_Mode (SwitchOn => False);
Set_Cbreak_Mode (SwitchOn => True);
Set_Echo_Mode (SwitchOn => False);
Allow_Scrolling (Mode => True);
Use_Insert_Delete_Line (Do_Idl => True);
Set_KeyPad_Mode (SwitchOn => True);
end Set_Terminal_Modes;
nap_msec : Integer := 1;
function Do_Single_Test (c : Character) return Boolean is
begin
case c is
when 'a' =>
getch_test;
when 'b' =>
attr_test;
when 'c' =>
if not Has_Colors then
Cannot ("does not support color.");
else
color_test;
end if;
when 'd' =>
if not Has_Colors then
Cannot ("does not support color.");
elsif not Can_Change_Color then
Cannot ("has hardwired color values.");
else
color_edit;
end if;
when 'e' =>
slk_test;
when 'f' =>
acs_display;
when 'o' =>
demo_panels (nap_msec);
when 'g' =>
acs_and_scroll;
when 'i' =>
flushinp_test (Standard_Window);
when 'k' =>
test_sgr_attributes;
when 'm' =>
menu_test;
when 'p' =>
demo_pad;
when 'r' =>
demo_forms;
when 's' =>
overlap_test;
when 't' =>
trace_set;
when '?' =>
null;
when others => return False;
end case;
return True;
end Do_Single_Test;
command : Character;
my_e_param : Soft_Label_Key_Format := Four_Four;
assumed_colors : Boolean := False;
default_colors : Boolean := False;
default_fg : Color_Number := White;
default_bg : Color_Number := Black;
-- nap_msec was an unsigned long integer in the C version,
-- yet napms only takes an int!
c : Integer;
c2 : Character;
optind : Integer := 1; -- must be initialized to one.
optarg : getopt.stringa;
length : Integer;
tmpi : Integer;
package myio is new Ada.Text_IO.Integer_IO (Integer);
use myio;
save_trace : Integer := 0;
save_trace_set : Trace_Attribute_Set;
function main return Integer is
begin
loop
Qgetopt (c, Argument_Count, Argument'Access,
"a:de:fhs:t:", optind, optarg);
exit when c = -1;
c2 := Character'Val (c);
case c2 is
when 'a' =>
-- Ada doesn't have scanf, it doesn't even have a
-- regular expression library.
assumed_colors := True;
myio.Get (optarg.all, Integer (default_fg), length);
myio.Get (optarg.all (length + 2 .. optarg.all'Length),
Integer (default_bg), length);
when 'd' =>
default_colors := True;
when 'e' =>
myio.Get (optarg.all, tmpi, length);
if tmpi > 3 then
usage;
return 1;
end if;
my_e_param := Soft_Label_Key_Format'Val (tmpi);
when 'f' =>
Rip_Off_Lines (-1, rip_footer'Access);
when 'h' =>
Rip_Off_Lines (1, rip_header'Access);
when 's' =>
myio.Get (optarg.all, nap_msec, length);
when 't' =>
myio.Get (optarg.all, save_trace, length);
when others =>
usage;
return 1;
end case;
end loop;
-- the C version had a bunch of macros here.
-- if (!isatty(fileno(stdin)))
-- isatty is not available in the standard Ada so skip it.
save_trace_set := To_trace (save_trace);
Trace_On (save_trace_set);
Init_Soft_Label_Keys (my_e_param);
Init_Screen;
Set_Background (Ch => (Ch => Blank,
Attr => Normal_Video,
Color => Color_Pair'First));
if Has_Colors then
Start_Color;
if default_colors then
Use_Default_Colors;
elsif assumed_colors then
Assume_Default_Colors (default_fg, default_bg);
end if;
end if;
Set_Terminal_Modes;
Save_Curses_Mode (Curses);
End_Windows;
-- TODO add macro #if blocks.
Put_Line ("Welcome to " & Curses_Version & ". Press ? for help.");
loop
Put_Line ("This is the ncurses main menu");
Put_Line ("a = keyboard and mouse input test");
Put_Line ("b = character attribute test");
Put_Line ("c = color test pattern");
Put_Line ("d = edit RGB color values");
Put_Line ("e = exercise soft keys");
Put_Line ("f = display ACS characters");
Put_Line ("g = display windows and scrolling");
Put_Line ("i = test of flushinp()");
Put_Line ("k = display character attributes");
Put_Line ("m = menu code test");
Put_Line ("o = exercise panels library");
Put_Line ("p = exercise pad features");
Put_Line ("q = quit");
Put_Line ("r = exercise forms code");
Put_Line ("s = overlapping-refresh test");
Put_Line ("t = set trace level");
Put_Line ("? = repeat this command summary");
Put ("> ");
Flush;
command := Ada.Characters.Latin_1.NUL;
-- get_input:
-- loop
declare
Ch : Character;
begin
Get (Ch);
-- TODO if read(ch) <= 0
-- TODO ada doesn't have an Is_Space function
command := Ch;
-- TODO if ch = '\n' or '\r' are these in Ada?
end;
-- end loop get_input;
declare
begin
if Do_Single_Test (command) then
Flush_Input;
Set_Terminal_Modes;
Reset_Curses_Mode (Curses);
Clear;
Refresh;
End_Windows;
if command = '?' then
Put_Line ("This is the ncurses capability tester.");
Put_Line ("You may select a test from the main menu by " &
"typing the");
Put_Line ("key letter of the choice (the letter to left " &
"of the =)");
Put_Line ("at the > prompt. The commands `x' or `q' will " &
"exit.");
end if;
-- continue; --why continue in the C version?
end if;
exception
when Curses_Exception => End_Windows;
end;
exit when command = 'q';
end loop;
Curses_Free_All;
return 0; -- TODO ExitProgram(EXIT_SUCCESS);
end main;
end ncurses2.m;

43
Ada95/samples/ncurses2-m.ads Normal file
View File

@ -0,0 +1,43 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
package ncurses2.m is
function main return Integer;
end ncurses2.m;

168
Ada95/samples/ncurses2-menu_test.adb Normal file
View File

@ -0,0 +1,168 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000-2004,2006 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.6 $
-- $Date: 2006/06/25 14:24:40 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with ncurses2.util; use ncurses2.util;
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus;
with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
procedure ncurses2.menu_test is
function menu_virtualize (c : Key_Code) return Menu_Request_Code;
procedure xAdd (l : Line_Position; c : Column_Position; s : String);
function menu_virtualize (c : Key_Code) return Menu_Request_Code is
begin
case c is
when Character'Pos (newl) | Key_Exit =>
return Menu_Request_Code'Last + 1; -- MAX_COMMAND? TODO
when Character'Pos ('u') =>
return M_ScrollUp_Line;
when Character'Pos ('d') =>
return M_ScrollDown_Line;
when Character'Pos ('b') | Key_Next_Page =>
return M_ScrollUp_Page;
when Character'Pos ('f') | Key_Previous_Page =>
return M_ScrollDown_Page;
when Character'Pos ('n') | Key_Cursor_Down =>
return M_Next_Item;
when Character'Pos ('p') | Key_Cursor_Up =>
return M_Previous_Item;
when Character'Pos (' ') =>
return M_Toggle_Item;
when Key_Mouse =>
return c;
when others =>
Beep;
return c;
end case;
end menu_virtualize;
MENU_Y : constant Line_Count := 8;
MENU_X : constant Column_Count := 8;
type String_Access is access String;
animals : constant array (Positive range <>) of String_Access :=
(new String'("Lions"),
new String'("Tigers"),
new String'("Bears"),
new String'("(Oh my!)"),
new String'("Newts"),
new String'("Platypi"),
new String'("Lemurs"));
items_a : constant Item_Array_Access :=
new Item_Array (1 .. animals'Last + 1);
tmp : Event_Mask;
procedure xAdd (l : Line_Position; c : Column_Position; s : String) is
begin
Add (Line => l, Column => c, Str => s);
end xAdd;
mrows : Line_Count;
mcols : Column_Count;
menuwin : Window;
m : Menu;
c1 : Key_Code;
c : Driver_Result;
r : Menu_Request_Code;
begin
tmp := Start_Mouse;
xAdd (0, 0, "This is the menu test:");
xAdd (2, 0, " Use up and down arrow to move the select bar.");
xAdd (3, 0, " 'n' and 'p' act like arrows.");
xAdd (4, 0, " 'b' and 'f' scroll up/down (page), 'u' and 'd' (line).");
xAdd (5, 0, " Press return to exit.");
Refresh;
for i in animals'Range loop
items_a (i) := New_Item (animals (i).all);
end loop;
items_a (animals'Last + 1) := Null_Item;
m := New_Menu (items_a);
Set_Format (m, Line_Position (animals'Last + 1) / 2, 1);
Scale (m, mrows, mcols);
menuwin := Create (mrows + 2, mcols + 2, MENU_Y, MENU_X);
Set_Window (m, menuwin);
Set_KeyPad_Mode (menuwin, True);
Box (menuwin); -- 0,0?
Set_Sub_Window (m, Derived_Window (menuwin, mrows, mcols, 1, 1));
Post (m);
loop
c1 := Getchar (menuwin);
r := menu_virtualize (c1);
c := Driver (m, r);
exit when c = Unknown_Request; -- E_UNKNOWN_COMMAND?
if c = Request_Denied then
Beep;
end if;
-- continue ?
end loop;
Move_Cursor (Line => Lines - 2, Column => 0);
Add (Str => "You chose: ");
Add (Str => Name (Current (m)));
Add (Ch => newl);
Pause; -- the C version didn't use Pause, it spelled it out
Post (m, False); -- unpost, not clear :-(
declare begin
Delete (menuwin);
exception when Curses_Exception => null; end;
-- menuwin has children so will raise the exception.
Delete (m);
End_Mouse (tmp);
end ncurses2.menu_test;

41
Ada95/samples/ncurses2-menu_test.ads Normal file
View File

@ -0,0 +1,41 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
procedure ncurses2.menu_test;

157
Ada95/samples/ncurses2-overlap_test.adb Normal file
View File

@ -0,0 +1,157 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000,2004 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.4 $
-- $Date: 2004/08/21 21:37:00 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with ncurses2.util; use ncurses2.util;
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
-- test effects of overlapping windows
procedure ncurses2.overlap_test is
procedure fillwin (win : Window; ch : Character);
procedure crosswin (win : Window; ch : Character);
procedure fillwin (win : Window; ch : Character) is
y1 : Line_Position;
x1 : Column_Position;
begin
Get_Size (win, y1, x1);
for y in 0 .. y1 - 1 loop
Move_Cursor (win, y, 0);
for x in 0 .. x1 - 1 loop
Add (win, Ch => ch);
end loop;
end loop;
exception
when Curses_Exception => null;
-- write to lower right corner
end fillwin;
procedure crosswin (win : Window; ch : Character) is
y1 : Line_Position;
x1 : Column_Position;
begin
Get_Size (win, y1, x1);
for y in 0 .. y1 - 1 loop
for x in 0 .. x1 - 1 loop
if ((x > (x1 - 1) / 3) and (x <= (2 * (x1 - 1)) / 3))
or (((y > (y1 - 1) / 3) and (y <= (2 * (y1 - 1)) / 3))) then
Move_Cursor (win, y, x);
Add (win, Ch => ch);
end if;
end loop;
end loop;
end crosswin;
-- In a 24x80 screen like some xterms are, the instructions will
-- be overwritten.
ch : Character;
win1 : Window := New_Window (9, 20, 3, 3);
win2 : Window := New_Window (9, 20, 9, 16);
begin
Set_Raw_Mode (SwitchOn => True);
Refresh;
Move_Cursor (Line => 0, Column => 0);
Add (Str => "This test shows the behavior of wnoutrefresh() with " &
"respect to");
Add (Ch => newl);
Add (Str => "the shared region of two overlapping windows A and B. "&
"The cross");
Add (Ch => newl);
Add (Str => "pattern in each window does not overlap the other.");
Add (Ch => newl);
Move_Cursor (Line => 18, Column => 0);
Add (Str => "a = refresh A, then B, then doupdate. b = refresh B, " &
"then A, then doupdaute");
Add (Ch => newl);
Add (Str => "c = fill window A with letter A. d = fill window B " &
"with letter B.");
Add (Ch => newl);
Add (Str => "e = cross pattern in window A. f = cross pattern " &
"in window B.");
Add (Ch => newl);
Add (Str => "g = clear window A. h = clear window B.");
Add (Ch => newl);
Add (Str => "i = overwrite A onto B. j = overwrite " &
"B onto A.");
Add (Ch => newl);
Add (Str => "^Q/ESC = terminate test.");
loop
ch := Code_To_Char (Getchar);
exit when ch = CTRL ('Q') or ch = CTRL ('['); -- QUIT or ESCAPE
case ch is
when 'a' => -- refresh window A first, then B
Refresh_Without_Update (win1);
Refresh_Without_Update (win2);
Update_Screen;
when 'b' => -- refresh window B first, then A
Refresh_Without_Update (win2);
Refresh_Without_Update (win1);
Update_Screen;
when 'c' => -- fill window A so it's visible
fillwin (win1, 'A');
when 'd' => -- fill window B so it's visible
fillwin (win2, 'B');
when 'e' => -- cross test pattern in window A
crosswin (win1, 'A');
when 'f' => -- cross test pattern in window B
crosswin (win2, 'B');
when 'g' => -- clear window A
Clear (win1);
Move_Cursor (win1, 0, 0);
when 'h' => -- clear window B
Clear (win2);
Move_Cursor (win2, 0, 0);
when 'i' => -- overwrite A onto B
Overwrite (win1, win2);
when 'j' => -- overwrite B onto A
Overwrite (win2, win1);
when others => null;
end case;
end loop;
Delete (win2);
Delete (win1);
Erase;
End_Windows;
end ncurses2.overlap_test;

41
Ada95/samples/ncurses2-overlap_test.ads Normal file
View File

@ -0,0 +1,41 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
procedure ncurses2.overlap_test;

174
Ada95/samples/ncurses2-slk_test.adb Normal file
View File

@ -0,0 +1,174 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000-2006,2009 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.8 $
-- $Date: 2009/12/26 17:38:58 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with ncurses2.util; use ncurses2.util;
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Ada.Strings.Unbounded;
with Interfaces.C;
with Terminal_Interface.Curses.Aux;
procedure ncurses2.slk_test is
procedure myGet (Win : Window := Standard_Window;
Str : out Ada.Strings.Unbounded.Unbounded_String;
Len : Integer := -1);
procedure myGet (Win : Window := Standard_Window;
Str : out Ada.Strings.Unbounded.Unbounded_String;
Len : Integer := -1)
is
use Ada.Strings.Unbounded;
use Interfaces.C;
use Terminal_Interface.Curses.Aux;
function Wgetnstr (Win : Window;
Str : char_array;
Len : int) return int;
pragma Import (C, Wgetnstr, "wgetnstr");
-- FIXME: how to construct "(Len > 0) ? Len : 80"?
Ask : constant Interfaces.C.size_t := Interfaces.C.size_t'Val (Len + 80);
Txt : char_array (0 .. Ask);
begin
Txt (0) := Interfaces.C.char'First;
if Wgetnstr (Win, Txt, Txt'Length) = Curses_Err then
raise Curses_Exception;
end if;
Str := To_Unbounded_String (To_Ada (Txt, True));
end myGet;
use Int_IO;
use Ada.Strings.Unbounded;
c : Key_Code;
buf : Unbounded_String;
c2 : Character;
fmt : Label_Justification := Centered;
tmp : Integer;
begin
c := CTRL ('l');
loop
Move_Cursor (Line => 0, Column => 0);
c2 := Code_To_Char (c);
case c2 is
when Character'Val (Character'Pos ('l') mod 16#20#) => -- CTRL('l')
Erase;
Switch_Character_Attribute (Attr => (Bold_Character => True,
others => False));
Add (Line => 0, Column => 20,
Str => "Soft Key Exerciser");
Switch_Character_Attribute (On => False,
Attr => (Bold_Character => True,
others => False));
Move_Cursor (Line => 2, Column => 0);
P ("Available commands are:");
P ("");
P ("^L -- refresh screen");
P ("a -- activate or restore soft keys");
P ("d -- disable soft keys");
P ("c -- set centered format for labels");
P ("l -- set left-justified format for labels");
P ("r -- set right-justified format for labels");
P ("[12345678] -- set label; labels are numbered 1 through 8");
P ("e -- erase stdscr (should not erase labels)");
P ("s -- test scrolling of shortened screen");
P ("x, q -- return to main menu");
P ("");
P ("Note: if activating the soft keys causes your terminal to");
P ("scroll up one line, your terminal auto-scrolls when anything");
P ("is written to the last screen position. The ncurses code");
P ("does not yet handle this gracefully.");
Refresh;
Restore_Soft_Label_Keys;
when 'a' =>
Restore_Soft_Label_Keys;
when 'e' =>
Clear;
when 's' =>
Add (Line => 20, Column => 0,
Str => "Press Q to stop the scrolling-test: ");
loop
c := Getchar;
c2 := Code_To_Char (c);
exit when c2 = 'Q';
-- c = ERR?
-- TODO when c is not a character (arrow key)
-- the behavior is different from the C version.
Add (Ch => c2);
end loop;
when 'd' =>
Clear_Soft_Label_Keys;
when 'l' =>
fmt := Left;
when 'c' =>
fmt := Centered;
when 'r' =>
fmt := Right;
when '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' =>
Add (Line => 20, Column => 0,
Str => "Please enter the label value: ");
Set_Echo_Mode (SwitchOn => True);
myGet (Str => buf);
Set_Echo_Mode (SwitchOn => False);
tmp := ctoi (c2);
Set_Soft_Label_Key (Label_Number (tmp), To_String (buf), fmt);
Refresh_Soft_Label_Keys;
Move_Cursor (Line => 20, Column => 0);
Clear_To_End_Of_Line;
when 'x' | 'q' =>
exit;
-- the C version needed a goto, ha ha
-- breaks exit the case not the loop because fall-throuh
-- happens in C!
when others =>
Beep;
end case;
c := Getchar;
-- TODO exit when c = EOF
end loop;
Erase;
End_Windows;
end ncurses2.slk_test;

41
Ada95/samples/ncurses2-slk_test.ads Normal file
View File

@ -0,0 +1,41 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
procedure ncurses2.slk_test;

185
Ada95/samples/ncurses2-test_sgr_attributes.adb Normal file
View File

@ -0,0 +1,185 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000,2006 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.2 $
-- $Date: 2006/06/25 14:24:40 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with ncurses2.util; use ncurses2.util;
-- Graphic-rendition test (adapted from vttest)
procedure ncurses2.test_sgr_attributes is
procedure xAdd (l : Line_Position; c : Column_Position; s : String);
procedure xAdd (l : Line_Position; c : Column_Position; s : String) is
begin
Add (Line => l, Column => c, Str => s);
end xAdd;
normal, current : Attributed_Character;
begin
for pass in reverse Boolean loop
if pass then
normal := (Ch => ' ', Attr => Normal_Video, Color => 0);
else
normal := (Ch => ' ', Attr =>
(Reverse_Video => True, others => False), Color => 0);
end if;
-- Use non-default colors if possible to exercise bce a little
if Has_Colors then
Init_Pair (1, White, Blue);
normal.Color := 1;
end if;
Set_Background (Ch => normal);
Erase;
xAdd (1, 20, "Graphic rendition test pattern:");
xAdd (4, 1, "vanilla");
current := normal;
current.Attr.Bold_Character := not current.Attr.Bold_Character;
Set_Background (Ch => current);
xAdd (4, 40, "bold");
current := normal;
current.Attr.Under_Line := not current.Attr.Under_Line;
Set_Background (Ch => current);
xAdd (6, 6, "underline");
current := normal;
current.Attr.Bold_Character := not current.Attr.Bold_Character;
current.Attr.Under_Line := not current.Attr.Under_Line;
Set_Background (Ch => current);
xAdd (6, 45, "bold underline");
current := normal;
current.Attr.Blink := not current.Attr.Blink;
Set_Background (Ch => current);
xAdd (8, 1, "blink");
current := normal;
current.Attr.Blink := not current.Attr.Blink;
current.Attr.Bold_Character := not current.Attr.Bold_Character;
Set_Background (Ch => current);
xAdd (8, 40, "bold blink");
current := normal;
current.Attr.Under_Line := not current.Attr.Under_Line;
current.Attr.Blink := not current.Attr.Blink;
Set_Background (Ch => current);
xAdd (10, 6, "underline blink");
current := normal;
current.Attr.Bold_Character := not current.Attr.Bold_Character;
current.Attr.Under_Line := not current.Attr.Under_Line;
current.Attr.Blink := not current.Attr.Blink;
Set_Background (Ch => current);
xAdd (10, 45, "bold underline blink");
current := normal;
current.Attr.Reverse_Video := not current.Attr.Reverse_Video;
Set_Background (Ch => current);
xAdd (12, 1, "negative");
current := normal;
current.Attr.Bold_Character := not current.Attr.Bold_Character;
current.Attr.Reverse_Video := not current.Attr.Reverse_Video;
Set_Background (Ch => current);
xAdd (12, 40, "bold negative");
current := normal;
current.Attr.Under_Line := not current.Attr.Under_Line;
current.Attr.Reverse_Video := not current.Attr.Reverse_Video;
Set_Background (Ch => current);
xAdd (14, 6, "underline negative");
current := normal;
current.Attr.Bold_Character := not current.Attr.Bold_Character;
current.Attr.Under_Line := not current.Attr.Under_Line;
current.Attr.Reverse_Video := not current.Attr.Reverse_Video;
Set_Background (Ch => current);
xAdd (14, 45, "bold underline negative");
current := normal;
current.Attr.Blink := not current.Attr.Blink;
current.Attr.Reverse_Video := not current.Attr.Reverse_Video;
Set_Background (Ch => current);
xAdd (16, 1, "blink negative");
current := normal;
current.Attr.Bold_Character := not current.Attr.Bold_Character;
current.Attr.Blink := not current.Attr.Blink;
current.Attr.Reverse_Video := not current.Attr.Reverse_Video;
Set_Background (Ch => current);
xAdd (16, 40, "bold blink negative");
current := normal;
current.Attr.Under_Line := not current.Attr.Under_Line;
current.Attr.Blink := not current.Attr.Blink;
current.Attr.Reverse_Video := not current.Attr.Reverse_Video;
Set_Background (Ch => current);
xAdd (18, 6, "underline blink negative");
current := normal;
current.Attr.Bold_Character := not current.Attr.Bold_Character;
current.Attr.Under_Line := not current.Attr.Under_Line;
current.Attr.Blink := not current.Attr.Blink;
current.Attr.Reverse_Video := not current.Attr.Reverse_Video;
Set_Background (Ch => current);
xAdd (18, 45, "bold underline blink negative");
Set_Background (Ch => normal);
Move_Cursor (Line => Lines - 2, Column => 1);
if pass then
Add (Str => "Dark");
else
Add (Str => "Light");
end if;
Add (Str => " background. ");
Clear_To_End_Of_Line;
Pause;
end loop;
Set_Background (Ch => Blank2);
Erase;
End_Windows;
end ncurses2.test_sgr_attributes;

41
Ada95/samples/ncurses2-test_sgr_attributes.ads Normal file
View File

@ -0,0 +1,41 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
procedure ncurses2.test_sgr_attributes;

480
Ada95/samples/ncurses2-trace_set.adb Normal file
View File

@ -0,0 +1,480 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses2.trace_set --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000-2006,2008 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.3 $
-- $Date: 2008/07/26 18:46:18 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with ncurses2.util; use ncurses2.util;
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Terminal_Interface.Curses.Trace; use Terminal_Interface.Curses.Trace;
with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus;
with Ada.Strings.Bounded;
-- interactively set the trace level
procedure ncurses2.trace_set is
function menu_virtualize (c : Key_Code) return Menu_Request_Code;
function subset (super, sub : Trace_Attribute_Set) return Boolean;
function trace_or (a, b : Trace_Attribute_Set) return Trace_Attribute_Set;
function trace_num (tlevel : Trace_Attribute_Set) return String;
function tracetrace (tlevel : Trace_Attribute_Set) return String;
function run_trace_menu (m : Menu; count : Integer) return Boolean;
function menu_virtualize (c : Key_Code) return Menu_Request_Code is
begin
case c is
when Character'Pos (newl) | Key_Exit =>
return Menu_Request_Code'Last + 1; -- MAX_COMMAND? TODO
when Character'Pos ('u') =>
return M_ScrollUp_Line;
when Character'Pos ('d') =>
return M_ScrollDown_Line;
when Character'Pos ('b') | Key_Next_Page =>
return M_ScrollUp_Page;
when Character'Pos ('f') | Key_Previous_Page =>
return M_ScrollDown_Page;
when Character'Pos ('n') | Key_Cursor_Down =>
return M_Next_Item;
when Character'Pos ('p') | Key_Cursor_Up =>
return M_Previous_Item;
when Character'Pos (' ') =>
return M_Toggle_Item;
when Key_Mouse =>
return c;
when others =>
Beep;
return c;
end case;
end menu_virtualize;
type string_a is access String;
type tbl_entry is record
name : string_a;
mask : Trace_Attribute_Set;
end record;
t_tbl : constant array (Positive range <>) of tbl_entry :=
(
(new String'("Disable"),
Trace_Disable),
(new String'("Times"),
Trace_Attribute_Set'(Times => True, others => False)),
(new String'("Tputs"),
Trace_Attribute_Set'(Tputs => True, others => False)),
(new String'("Update"),
Trace_Attribute_Set'(Update => True, others => False)),
(new String'("Cursor_Move"),
Trace_Attribute_Set'(Cursor_Move => True, others => False)),
(new String'("Character_Output"),
Trace_Attribute_Set'(Character_Output => True, others => False)),
(new String'("Ordinary"),
Trace_Ordinary),
(new String'("Calls"),
Trace_Attribute_Set'(Calls => True, others => False)),
(new String'("Virtual_Puts"),
Trace_Attribute_Set'(Virtual_Puts => True, others => False)),
(new String'("Input_Events"),
Trace_Attribute_Set'(Input_Events => True, others => False)),
(new String'("TTY_State"),
Trace_Attribute_Set'(TTY_State => True, others => False)),
(new String'("Internal_Calls"),
Trace_Attribute_Set'(Internal_Calls => True, others => False)),
(new String'("Character_Calls"),
Trace_Attribute_Set'(Character_Calls => True, others => False)),
(new String'("Termcap_TermInfo"),
Trace_Attribute_Set'(Termcap_TermInfo => True, others => False)),
(new String'("Maximium"),
Trace_Maximum)
);
package BS is new Ada.Strings.Bounded.Generic_Bounded_Length (300);
function subset (super, sub : Trace_Attribute_Set) return Boolean is
begin
if
(super.Times or not sub.Times) and
(super.Tputs or not sub.Tputs) and
(super.Update or not sub.Update) and
(super.Cursor_Move or not sub.Cursor_Move) and
(super.Character_Output or not sub.Character_Output) and
(super.Calls or not sub.Calls) and
(super.Virtual_Puts or not sub.Virtual_Puts) and
(super.Input_Events or not sub.Input_Events) and
(super.TTY_State or not sub.TTY_State) and
(super.Internal_Calls or not sub.Internal_Calls) and
(super.Character_Calls or not sub.Character_Calls) and
(super.Termcap_TermInfo or not sub.Termcap_TermInfo) and
True then
return True;
else
return False;
end if;
end subset;
function trace_or (a, b : Trace_Attribute_Set) return Trace_Attribute_Set is
retval : Trace_Attribute_Set := Trace_Disable;
begin
retval.Times := (a.Times or b.Times);
retval.Tputs := (a.Tputs or b.Tputs);
retval.Update := (a.Update or b.Update);
retval.Cursor_Move := (a.Cursor_Move or b.Cursor_Move);
retval.Character_Output := (a.Character_Output or b.Character_Output);
retval.Calls := (a.Calls or b.Calls);
retval.Virtual_Puts := (a.Virtual_Puts or b.Virtual_Puts);
retval.Input_Events := (a.Input_Events or b.Input_Events);
retval.TTY_State := (a.TTY_State or b.TTY_State);
retval.Internal_Calls := (a.Internal_Calls or b.Internal_Calls);
retval.Character_Calls := (a.Character_Calls or b.Character_Calls);
retval.Termcap_TermInfo := (a.Termcap_TermInfo or b.Termcap_TermInfo);
return retval;
end trace_or;
-- Print the hexadecimal value of the mask so
-- users can set it from the command line.
function trace_num (tlevel : Trace_Attribute_Set) return String is
result : Integer := 0;
m : Integer := 1;
begin
if tlevel.Times then
result := result + m;
end if;
m := m * 2;
if tlevel.Tputs then
result := result + m;
end if;
m := m * 2;
if tlevel.Update then
result := result + m;
end if;
m := m * 2;
if tlevel.Cursor_Move then
result := result + m;
end if;
m := m * 2;
if tlevel.Character_Output then
result := result + m;
end if;
m := m * 2;
if tlevel.Calls then
result := result + m;
end if;
m := m * 2;
if tlevel.Virtual_Puts then
result := result + m;
end if;
m := m * 2;
if tlevel.Input_Events then
result := result + m;
end if;
m := m * 2;
if tlevel.TTY_State then
result := result + m;
end if;
m := m * 2;
if tlevel.Internal_Calls then
result := result + m;
end if;
m := m * 2;
if tlevel.Character_Calls then
result := result + m;
end if;
m := m * 2;
if tlevel.Termcap_TermInfo then
result := result + m;
end if;
m := m * 2;
return result'Img;
end trace_num;
function tracetrace (tlevel : Trace_Attribute_Set) return String is
use BS;
buf : Bounded_String := To_Bounded_String ("");
begin
-- The C version prints the hexadecimal value of the mask, we
-- won't do that here because this is Ada.
if tlevel = Trace_Disable then
Append (buf, "Trace_Disable");
else
if subset (tlevel,
Trace_Attribute_Set'(Times => True, others => False)) then
Append (buf, "Times");
Append (buf, ", ");
end if;
if subset (tlevel,
Trace_Attribute_Set'(Tputs => True, others => False)) then
Append (buf, "Tputs");
Append (buf, ", ");
end if;
if subset (tlevel,
Trace_Attribute_Set'(Update => True, others => False)) then
Append (buf, "Update");
Append (buf, ", ");
end if;
if subset (tlevel,
Trace_Attribute_Set'(Cursor_Move => True,
others => False)) then
Append (buf, "Cursor_Move");
Append (buf, ", ");
end if;
if subset (tlevel,
Trace_Attribute_Set'(Character_Output => True,
others => False)) then
Append (buf, "Character_Output");
Append (buf, ", ");
end if;
if subset (tlevel,
Trace_Ordinary) then
Append (buf, "Ordinary");
Append (buf, ", ");
end if;
if subset (tlevel,
Trace_Attribute_Set'(Calls => True, others => False)) then
Append (buf, "Calls");
Append (buf, ", ");
end if;
if subset (tlevel,
Trace_Attribute_Set'(Virtual_Puts => True,
others => False)) then
Append (buf, "Virtual_Puts");
Append (buf, ", ");
end if;
if subset (tlevel,
Trace_Attribute_Set'(Input_Events => True,
others => False)) then
Append (buf, "Input_Events");
Append (buf, ", ");
end if;
if subset (tlevel,
Trace_Attribute_Set'(TTY_State => True,
others => False)) then
Append (buf, "TTY_State");
Append (buf, ", ");
end if;
if subset (tlevel,
Trace_Attribute_Set'(Internal_Calls => True,
others => False)) then
Append (buf, "Internal_Calls");
Append (buf, ", ");
end if;
if subset (tlevel,
Trace_Attribute_Set'(Character_Calls => True,
others => False)) then
Append (buf, "Character_Calls");
Append (buf, ", ");
end if;
if subset (tlevel,
Trace_Attribute_Set'(Termcap_TermInfo => True,
others => False)) then
Append (buf, "Termcap_TermInfo");
Append (buf, ", ");
end if;
if subset (tlevel,
Trace_Maximum) then
Append (buf, "Maximium");
Append (buf, ", ");
end if;
end if;
if To_String (buf) (Length (buf) - 1) = ',' then
Delete (buf, Length (buf) - 1, Length (buf));
end if;
return To_String (buf);
end tracetrace;
function run_trace_menu (m : Menu; count : Integer) return Boolean is
i, p : Item;
changed : Boolean;
c, v : Key_Code;
begin
loop
changed := (count /= 0);
c := Getchar (Get_Window (m));
v := menu_virtualize (c);
case Driver (m, v) is
when Unknown_Request =>
return False;
when others =>
i := Current (m);
if i = Menus.Items (m, 1) then -- the first item
for n in t_tbl'First + 1 .. t_tbl'Last loop
if Value (i) then
Set_Value (i, False);
changed := True;
end if;
end loop;
else
for n in t_tbl'First + 1 .. t_tbl'Last loop
p := Menus.Items (m, n);
if Value (p) then
Set_Value (Menus.Items (m, 1), False);
changed := True;
exit;
end if;
end loop;
end if;
if not changed then
return True;
end if;
end case;
end loop;
end run_trace_menu;
nc_tracing, mask : Trace_Attribute_Set;
pragma Import (C, nc_tracing, "_nc_tracing");
items_a : constant Item_Array_Access :=
new Item_Array (t_tbl'First .. t_tbl'Last + 1);
mrows : Line_Count;
mcols : Column_Count;
menuwin : Window;
menu_y : constant Line_Position := 8;
menu_x : constant Column_Position := 8;
ip : Item;
m : Menu;
count : Integer;
newtrace : Trace_Attribute_Set;
begin
Add (Line => 0, Column => 0, Str => "Interactively set trace level:");
Add (Line => 2, Column => 0,
Str => " Press space bar to toggle a selection.");
Add (Line => 3, Column => 0,
Str => " Use up and down arrow to move the select bar.");
Add (Line => 4, Column => 0,
Str => " Press return to set the trace level.");
Add (Line => 6, Column => 0, Str => "(Current trace level is ");
Add (Str => tracetrace (nc_tracing) & " numerically: " &
trace_num (nc_tracing));
Add (Ch => ')');
Refresh;
for n in t_tbl'Range loop
items_a (n) := New_Item (t_tbl (n).name.all);
end loop;
items_a (t_tbl'Last + 1) := Null_Item;
m := New_Menu (items_a);
Set_Format (m, 16, 2);
Scale (m, mrows, mcols);
Switch_Options (m, (One_Valued => True, others => False), On => False);
menuwin := New_Window (mrows + 2, mcols + 2, menu_y, menu_x);
Set_Window (m, menuwin);
Set_KeyPad_Mode (menuwin, SwitchOn => True);
Box (menuwin);
Set_Sub_Window (m, Derived_Window (menuwin, mrows, mcols, 1, 1));
Post (m);
for n in t_tbl'Range loop
ip := Items (m, n);
mask := t_tbl (n).mask;
if mask = Trace_Disable then
Set_Value (ip, nc_tracing = Trace_Disable);
elsif subset (sub => mask, super => nc_tracing) then
Set_Value (ip, True);
end if;
end loop;
count := 1;
while run_trace_menu (m, count) loop
count := count + 1;
end loop;
newtrace := Trace_Disable;
for n in t_tbl'Range loop
ip := Items (m, n);
if Value (ip) then
mask := t_tbl (n).mask;
newtrace := trace_or (newtrace, mask);
end if;
end loop;
Trace_On (newtrace);
Trace_Put ("trace level interactively set to " &
tracetrace (nc_tracing));
Move_Cursor (Line => Lines - 4, Column => 0);
Add (Str => "Trace level is ");
Add (Str => tracetrace (nc_tracing));
Add (Ch => newl);
Pause; -- was just Add(); Getchar
Post (m, False);
-- menuwin has subwindows I think, which makes an error.
declare begin
Delete (menuwin);
exception when Curses_Exception => null; end;
-- free_menu(m);
-- free_item()
end ncurses2.trace_set;

41
Ada95/samples/ncurses2-trace_set.ads Normal file
View File

@ -0,0 +1,41 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses2.trace_set --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
procedure ncurses2.trace_set;

190
Ada95/samples/ncurses2-util.adb Normal file
View File

@ -0,0 +1,190 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses2.util --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000-2006,2008 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.7 $
-- $Date: 2008/07/26 18:51:20 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Text_IO; use Ada.Text_IO;
pragma Warnings (Off);
with Terminal_Interface.Curses.Aux;
pragma Warnings (On);
with Terminal_Interface.Curses.Trace; use Terminal_Interface.Curses.Trace;
with Interfaces.C;
with Interfaces.C.Strings;
with Ada.Characters.Handling;
with ncurses2.genericPuts;
package body ncurses2.util is
-- #defines from C
-- #define CTRL(x) ((x) & 0x1f)
function CTRL (c : Character) return Key_Code is
begin
return Character'Pos (c) mod 16#20#;
-- uses a property of ASCII
-- A = 16#41#; a = 16#61#; ^A = 1 or 16#1#
end CTRL;
function CTRL (c : Character) return Character is
begin
return Character'Val (Character'Pos (c) mod 16#20#);
-- uses a property of ASCII
-- A = 16#41#; a = 16#61#; ^A = 1 or 16#1#
end CTRL;
save_trace : Trace_Attribute_Set;
-- Common function to allow ^T to toggle trace-mode in the middle of a test
-- so that trace-files can be made smaller.
function Getchar (win : Window := Standard_Window) return Key_Code is
c : Key_Code;
begin
-- #ifdef TRACE
c := Get_Keystroke (win);
while c = CTRL ('T') loop
-- if _nc_tracing in C
if Current_Trace_Setting /= Trace_Disable then
save_trace := Current_Trace_Setting;
Trace_Put ("TOGGLE-TRACING OFF");
Current_Trace_Setting := Trace_Disable;
else
Current_Trace_Setting := save_trace;
end if;
Trace_On (Current_Trace_Setting);
if Current_Trace_Setting /= Trace_Disable then
Trace_Put ("TOGGLE-TRACING ON");
end if;
end loop;
-- #else c := Get_Keystroke;
return c;
end Getchar;
procedure Getchar (win : Window := Standard_Window) is
begin
if Getchar (win) < 0 then
Beep;
end if;
end Getchar;
procedure Pause is
begin
Move_Cursor (Line => Lines - 1, Column => 0);
Add (Str => "Press any key to continue... ");
Getchar;
end Pause;
procedure Cannot (s : String) is
use Interfaces.C;
use Interfaces.C.Strings;
use Terminal_Interface.Curses.Aux;
function getenv (x : char_array) return chars_ptr;
pragma Import (C, getenv, "getenv");
tmp1 : char_array (0 .. 10);
package p is new ncurses2.genericPuts (1024);
use p;
use p.BS;
tmpb : BS.Bounded_String;
Length : size_t;
begin
To_C ("TERM", tmp1, Length);
Fill_String (getenv (tmp1), tmpb);
Add (Ch => newl);
myAdd (Str => "This " & tmpb & " terminal " & s);
Pause;
end Cannot;
procedure ShellOut (message : Boolean) is
use Interfaces.C;
Txt : char_array (0 .. 10);
Length : size_t;
procedure system (x : char_array);
pragma Import (C, system, "system");
begin
To_C ("sh", Txt, Length);
if message then
Add (Str => "Shelling out...");
end if;
Save_Curses_Mode (Mode => Curses);
End_Windows;
system (Txt);
if message then
Add (Str => "returned from shellout.");
Add (Ch => newl);
end if;
Refresh;
end ShellOut;
function Is_Digit (c : Key_Code) return Boolean is
begin
if c >= 16#100# then
return False;
else
return Ada.Characters.Handling.Is_Digit (Character'Val (c));
end if;
end Is_Digit;
procedure P (s : String) is
begin
Add (Str => s);
Add (Ch => newl);
end P;
function Code_To_Char (c : Key_Code) return Character is
begin
if c > Character'Pos (Character'Last) then
return Character'Val (0);
-- maybe raise exception?
else
return Character'Val (c);
end if;
end Code_To_Char;
-- This was untestable due to a bug in GNAT (3.12p)
-- Hmm, what bug? I don't remember.
function ctoi (c : Character) return Integer is
begin
return Character'Pos (c) - Character'Pos ('0');
end ctoi;
end ncurses2.util;

76
Ada95/samples/ncurses2-util.ads Normal file
View File

@ -0,0 +1,76 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses2.util --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000,2006 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.2 $
-- $Date: 2006/06/25 14:24:40 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Ada.Text_IO;
package ncurses2.util is
Blank : constant Character := ' ';
Blank2 : constant Attributed_Character :=
(Ch => Blank, Attr => Normal_Video, Color => Color_Pair'First);
newl : constant Character := Character'Val (10);
function CTRL (c : Character) return Key_Code;
function CTRL (c : Character) return Character;
function Getchar (win : Window := Standard_Window) return Key_Code;
procedure Getchar (win : Window := Standard_Window);
procedure Pause;
procedure Cannot (s : String);
procedure ShellOut (message : Boolean);
package Int_IO is new Ada.Text_IO.Integer_IO (Integer);
function Is_Digit (c : Key_Code) return Boolean;
procedure P (s : String);
function Code_To_Char (c : Key_Code) return Character;
function ctoi (c : Character) return Integer;
end ncurses2.util;

44
Ada95/samples/ncurses2.ads Normal file
View File

@ -0,0 +1,44 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- ncurses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 2000 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
-- $Revision: 1.1 $
-- Binding Version 01.00
------------------------------------------------------------------------------
package ncurses2 is
pragma Pure (ncurses2);
end ncurses2;

179
Ada95/samples/rain.adb Normal file
View File

@ -0,0 +1,179 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Rain --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2007,2008 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Laurent Pautet <pautet@gnat.com>
-- Modified by: Juergen Pfeifer, 1997
-- Version Control
-- $Revision: 1.8 $
-- $Date: 2008/08/30 21:38:07 $
-- Binding Version 01.00
------------------------------------------------------------------------------
-- --
with ncurses2.util; use ncurses2.util;
with Ada.Numerics.Float_Random; use Ada.Numerics.Float_Random;
with Status; use Status;
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
procedure Rain is
Visibility : Cursor_Visibility;
subtype X_Position is Line_Position;
subtype Y_Position is Column_Position;
Xpos : array (1 .. 5) of X_Position;
Ypos : array (1 .. 5) of Y_Position;
done : Boolean;
c : Key_Code;
N : Integer;
G : Generator;
Max_X, X : X_Position;
Max_Y, Y : Y_Position;
procedure Next (J : in out Integer);
procedure Cursor (X : X_Position; Y : Y_Position);
procedure Next (J : in out Integer) is
begin
if J = 5 then
J := 1;
else
J := J + 1;
end if;
end Next;
procedure Cursor (X : X_Position; Y : Y_Position) is
begin
Move_Cursor (Line => X, Column => Y);
end Cursor;
pragma Inline (Cursor);
begin
Init_Screen;
Set_NL_Mode;
Set_Echo_Mode (False);
Visibility := Invisible;
Set_Cursor_Visibility (Visibility);
Set_Timeout_Mode (Standard_Window, Non_Blocking, 0);
Max_X := Lines - 5;
Max_Y := Columns - 5;
for I in Xpos'Range loop
Xpos (I) := X_Position (Float (Max_X) * Random (G)) + 2;
Ypos (I) := Y_Position (Float (Max_Y) * Random (G)) + 2;
end loop;
N := 1;
done := False;
while not done and Process.Continue loop
X := X_Position (Float (Max_X) * Random (G)) + 2;
Y := Y_Position (Float (Max_Y) * Random (G)) + 2;
Cursor (X, Y);
Add (Ch => '.');
Cursor (Xpos (N), Ypos (N));
Add (Ch => 'o');
--
Next (N);
Cursor (Xpos (N), Ypos (N));
Add (Ch => 'O');
--
Next (N);
Cursor (Xpos (N) - 1, Ypos (N));
Add (Ch => '-');
Cursor (Xpos (N), Ypos (N) - 1);
Add (Str => "|.|");
Cursor (Xpos (N) + 1, Ypos (N));
Add (Ch => '-');
--
Next (N);
Cursor (Xpos (N) - 2, Ypos (N));
Add (Ch => '-');
Cursor (Xpos (N) - 1, Ypos (N) - 1);
Add (Str => "/\\");
Cursor (Xpos (N), Ypos (N) - 2);
Add (Str => "| O |");
Cursor (Xpos (N) + 1, Ypos (N) - 1);
Add (Str => "\\/");
Cursor (Xpos (N) + 2, Ypos (N));
Add (Ch => '-');
--
Next (N);
Cursor (Xpos (N) - 2, Ypos (N));
Add (Ch => ' ');
Cursor (Xpos (N) - 1, Ypos (N) - 1);
Add (Str => " ");
Cursor (Xpos (N), Ypos (N) - 2);
Add (Str => " ");
Cursor (Xpos (N) + 1, Ypos (N) - 1);
Add (Str => " ");
Cursor (Xpos (N) + 2, Ypos (N));
Add (Ch => ' ');
Xpos (N) := X;
Ypos (N) := Y;
c := Getchar;
case c is
when Character'Pos ('q') => done := True;
when Character'Pos ('Q') => done := True;
when Character'Pos ('s') => Set_NoDelay_Mode (Standard_Window, False);
when Character'Pos (' ') => Set_NoDelay_Mode (Standard_Window, True);
when others => null;
end case;
Nap_Milli_Seconds (50);
end loop;
Visibility := Normal;
Set_Cursor_Visibility (Visibility);
End_Windows;
Curses_Free_All;
end Rain;

43
Ada95/samples/rain.ads Normal file
View File

@ -0,0 +1,43 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Rain --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Laurent Pautet <pautet@gnat.com>
-- Modified by: Juergen Pfeifer, 1997
-- Version Control
-- $Revision: 1.6 $
-- Binding Version 01.00
------------------------------------------------------------------------------
-- --
procedure Rain;

122
Ada95/samples/sample-curses_demo-attributes.adb Normal file
View File

@ -0,0 +1,122 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Curses_Demo.Attributes --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.12 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
with Sample.Manifest; use Sample.Manifest;
with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
with Sample.Explanation; use Sample.Explanation;
package body Sample.Curses_Demo.Attributes is
procedure Demo
is
P : Panel := Create (Standard_Window);
K : Real_Key_Code;
begin
Set_Meta_Mode;
Set_KeyPad_Mode;
Top (P);
Push_Environment ("ATTRIBDEMO");
Default_Labels;
Notepad ("ATTRIB-PAD00");
Set_Character_Attributes (Attr => (others => False));
Add (Line => 1, Column => Columns / 2 - 10,
Str => "This is NORMAL");
Set_Character_Attributes (Attr => (Stand_Out => True,
others => False));
Add (Line => 2, Column => Columns / 2 - 10,
Str => "This is Stand_Out");
Set_Character_Attributes (Attr => (Under_Line => True,
others => False));
Add (Line => 3, Column => Columns / 2 - 10,
Str => "This is Under_Line");
Set_Character_Attributes (Attr => (Reverse_Video => True,
others => False));
Add (Line => 4, Column => Columns / 2 - 10,
Str => "This is Reverse_Video");
Set_Character_Attributes (Attr => (Blink => True,
others => False));
Add (Line => 5, Column => Columns / 2 - 10,
Str => "This is Blink");
Set_Character_Attributes (Attr => (Dim_Character => True,
others => False));
Add (Line => 6, Column => Columns / 2 - 10,
Str => "This is Dim_Character");
Set_Character_Attributes (Attr => (Bold_Character => True,
others => False));
Add (Line => 7, Column => Columns / 2 - 10,
Str => "This is Bold_Character");
Refresh_Without_Update;
Update_Panels; Update_Screen;
loop
K := Get_Key;
if K in Special_Key_Code'Range then
case K is
when QUIT_CODE => exit;
when HELP_CODE => Explain_Context;
when EXPLAIN_CODE => Explain ("ATTRIBKEYS");
when others => null;
end case;
end if;
end loop;
Pop_Environment;
Clear;
Refresh_Without_Update;
Delete (P);
Update_Panels; Update_Screen;
end Demo;
end Sample.Curses_Demo.Attributes;

45
Ada95/samples/sample-curses_demo-attributes.ads Normal file
View File

@ -0,0 +1,45 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Curses_Demo.Attributes --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.9 $
-- Binding Version 01.00
------------------------------------------------------------------------------
package Sample.Curses_Demo.Attributes is
procedure Demo;
end Sample.Curses_Demo.Attributes;

220
Ada95/samples/sample-curses_demo-mouse.adb Normal file
View File

@ -0,0 +1,220 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Curses_Demo.Mouse --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2006,2008 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.16 $
-- $Date: 2008/07/26 18:48:19 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
with Terminal_Interface.Curses.Text_IO; use Terminal_Interface.Curses.Text_IO;
with Terminal_Interface.Curses.Text_IO.Integer_IO;
with Terminal_Interface.Curses.Text_IO.Enumeration_IO;
with Sample.Helpers; use Sample.Helpers;
with Sample.Manifest; use Sample.Manifest;
with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
with Sample.Explanation; use Sample.Explanation;
package body Sample.Curses_Demo.Mouse is
package Int_IO is new
Terminal_Interface.Curses.Text_IO.Integer_IO (Integer);
use Int_IO;
package Button_IO is new
Terminal_Interface.Curses.Text_IO.Enumeration_IO (Mouse_Button);
use Button_IO;
package State_IO is new
Terminal_Interface.Curses.Text_IO.Enumeration_IO (Button_State);
use State_IO;
procedure Demo is
type Controls is array (1 .. 3) of Panel;
Frame : Window;
Msg : Window;
Ctl : Controls;
Pan : Panel;
K : Real_Key_Code;
V : Cursor_Visibility := Invisible;
W : Window;
Note : Window;
Msg_L : constant Line_Count := 8;
Lins : Line_Position := Lines;
Cols : Column_Position;
Mask : Event_Mask;
procedure Show_Mouse_Event;
procedure Show_Mouse_Event
is
Evt : constant Mouse_Event := Get_Mouse;
Y : Line_Position;
X : Column_Position;
Button : Mouse_Button;
State : Button_State;
W : Window;
begin
Get_Event (Evt, Y, X, Button, State);
Put (Msg, "Event at");
Put (Msg, " X="); Put (Msg, Integer (X), 3);
Put (Msg, ", Y="); Put (Msg, Integer (Y), 3);
Put (Msg, ", Btn="); Put (Msg, Button, 10);
Put (Msg, ", Stat="); Put (Msg, State, 15);
for I in Ctl'Range loop
W := Get_Window (Ctl (I));
if Enclosed_In_Window (W, Evt) then
Transform_Coordinates (W, Y, X, From_Screen);
Put (Msg, ",Box(");
Put (Msg, (I), 1); Put (Msg, ",");
Put (Msg, Integer (Y), 1); Put (Msg, ",");
Put (Msg, Integer (X), 1); Put (Msg, ")");
end if;
end loop;
New_Line (Msg);
Flush (Msg);
Update_Panels; Update_Screen;
end Show_Mouse_Event;
begin
Push_Environment ("MOUSE00");
Notepad ("MOUSE-PAD00");
Default_Labels;
Set_Cursor_Visibility (V);
Note := Notepad_Window;
if Note /= Null_Window then
Get_Window_Position (Note, Lins, Cols);
end if;
Frame := Create (Msg_L, Columns, Lins - Msg_L, 0);
if Has_Colors then
Set_Background (Win => Frame,
Ch => (Color => Default_Colors,
Attr => Normal_Video,
Ch => ' '));
Set_Character_Attributes (Win => Frame,
Attr => Normal_Video,
Color => Default_Colors);
Erase (Frame);
end if;
Msg := Derived_Window (Frame, Msg_L - 2, Columns - 2, 1, 1);
Pan := Create (Frame);
Set_Meta_Mode;
Set_KeyPad_Mode;
Mask := Start_Mouse;
Box (Frame);
Window_Title (Frame, "Mouse Protocol");
Refresh_Without_Update (Frame);
Allow_Scrolling (Msg, True);
declare
Middle_Column : constant Integer := Integer (Columns) / 2;
Middle_Index : constant Natural := Ctl'First + (Ctl'Length / 2);
Width : constant Column_Count := 5;
Height : constant Line_Count := 3;
Half : constant Column_Count := Width / 2;
Space : constant Column_Count := 3;
Position : Integer;
W : Window;
begin
for I in Ctl'Range loop
Position := ((I) - Integer (Middle_Index)) *
Integer (Half + Space + Width) + Middle_Column;
W := Create (Height,
Width,
1,
Column_Position (Position));
if Has_Colors then
Set_Background (Win => W,
Ch => (Color => Menu_Back_Color,
Attr => Normal_Video,
Ch => ' '));
Set_Character_Attributes (Win => W,
Attr => Normal_Video,
Color => Menu_Fore_Color);
Erase (W);
end if;
Ctl (I) := Create (W);
Box (W);
Move_Cursor (W, 1, Half);
Put (W, (I), 1);
Refresh_Without_Update (W);
end loop;
end;
Update_Panels; Update_Screen;
loop
K := Get_Key;
if K in Special_Key_Code'Range then
case K is
when QUIT_CODE => exit;
when HELP_CODE => Explain_Context;
when EXPLAIN_CODE => Explain ("MOUSEKEYS");
when Key_Mouse => Show_Mouse_Event;
when others => null;
end case;
end if;
end loop;
for I in Ctl'Range loop
W := Get_Window (Ctl (I));
Clear (W);
Delete (Ctl (I));
Delete (W);
end loop;
Clear (Frame);
Delete (Pan);
Delete (Msg);
Delete (Frame);
Set_Cursor_Visibility (V);
End_Mouse (Mask);
Pop_Environment;
Update_Panels; Update_Screen;
end Demo;
end Sample.Curses_Demo.Mouse;

45
Ada95/samples/sample-curses_demo-mouse.ads Normal file
View File

@ -0,0 +1,45 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Curses_Demo.Mouse --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.9 $
-- Binding Version 01.00
------------------------------------------------------------------------------
package Sample.Curses_Demo.Mouse is
procedure Demo;
end Sample.Curses_Demo.Mouse;

143
Ada95/samples/sample-curses_demo.adb Normal file
View File

@ -0,0 +1,143 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Curses_Demo --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998,2004 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.15 $
-- $Date: 2004/08/21 21:37:00 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus;
with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
with Terminal_Interface.Curses.Panels.User_Data;
with Sample.Manifest; use Sample.Manifest;
with Sample.Helpers; use Sample.Helpers;
with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
with Sample.Explanation; use Sample.Explanation;
with Sample.Menu_Demo.Handler;
with Sample.Curses_Demo.Mouse;
with Sample.Curses_Demo.Attributes;
package body Sample.Curses_Demo is
type User_Data is new Integer;
type User_Data_Access is access all User_Data;
package PUD is new Panels.User_Data (User_Data, User_Data_Access);
-- We use above instantiation of the generic User_Data package to
-- demonstrate and test the use of the user data maechanism.
procedure Demo
is
function My_Driver (M : Menu;
K : Key_Code;
Pan : Panel) return Boolean;
package Mh is new Sample.Menu_Demo.Handler (My_Driver);
Itm : Item_Array_Access := new Item_Array'
(New_Item ("Attributes Demo"),
New_Item ("Mouse Demo"),
Null_Item);
M : Menu := New_Menu (Itm);
U1 : constant User_Data_Access := new User_Data'(4711);
U2 : User_Data_Access;
function My_Driver (M : Menu;
K : Key_Code;
Pan : Panel) return Boolean
is
Idx : constant Positive := Get_Index (Current (M));
Result : Boolean := False;
begin
PUD.Set_User_Data (Pan, U1); -- set some user data, just for fun
if K in User_Key_Code'Range then
if K = QUIT then
Result := True;
elsif K = SELECT_ITEM then
if Idx in Itm'Range then
Hide (Pan);
Update_Panels;
end if;
case Idx is
when 1 => Sample.Curses_Demo.Attributes.Demo;
when 2 => Sample.Curses_Demo.Mouse.Demo;
when others => Not_Implemented;
end case;
if Idx in Itm'Range then
Top (Pan);
Show (Pan);
Update_Panels;
Update_Screen;
end if;
end if;
end if;
PUD.Get_User_Data (Pan, U2); -- get the user data
pragma Assert (U1.all = U2.all and then U1 = U2);
return Result;
end My_Driver;
begin
if (1 + Item_Count (M)) /= Itm'Length then
raise Constraint_Error;
end if;
if not Has_Mouse then
declare
O : Item_Option_Set;
begin
Get_Options (Itm (2), O);
O.Selectable := False;
Set_Options (Itm (2), O);
end;
end if;
Push_Environment ("CURSES00");
Notepad ("CURSES-PAD00");
Default_Labels;
Refresh_Soft_Label_Keys_Without_Update;
Mh.Drive_Me (M, " Demo ");
Pop_Environment;
Delete (M);
Free (Itm, True);
end Demo;
end Sample.Curses_Demo;

45
Ada95/samples/sample-curses_demo.ads Normal file
View File

@ -0,0 +1,45 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Curses_Demo --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.9 $
-- Binding Version 01.00
------------------------------------------------------------------------------
package Sample.Curses_Demo is
procedure Demo;
end Sample.Curses_Demo;

408
Ada95/samples/sample-explanation.adb Normal file
View File

@ -0,0 +1,408 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Explanation --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2006,2009 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.21 $
-- $Date: 2009/12/26 17:38:58 $
-- Binding Version 01.00
------------------------------------------------------------------------------
-- Poor mans help system. This scans a sequential file for key lines and
-- then reads the lines up to the next key. Those lines are presented in
-- a window as help or explanation.
--
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Deallocation;
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
with Sample.Manifest; use Sample.Manifest;
with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
with Sample.Helpers; use Sample.Helpers;
package body Sample.Explanation is
Help_Keys : constant String := "HELPKEYS";
In_Help : constant String := "INHELP";
File_Name : constant String := "explain.msg";
F : File_Type;
type Help_Line;
type Help_Line_Access is access Help_Line;
pragma Controlled (Help_Line_Access);
type String_Access is access String;
pragma Controlled (String_Access);
type Help_Line is
record
Prev, Next : Help_Line_Access;
Line : String_Access;
end record;
procedure Explain (Key : String;
Win : Window);
procedure Release_String is
new Ada.Unchecked_Deallocation (String,
String_Access);
procedure Release_Help_Line is
new Ada.Unchecked_Deallocation (Help_Line,
Help_Line_Access);
function Search (Key : String) return Help_Line_Access;
procedure Release_Help (Root : in out Help_Line_Access);
procedure Explain (Key : String)
is
begin
Explain (Key, Null_Window);
end Explain;
procedure Explain (Key : String;
Win : Window)
is
-- Retrieve the text associated with this key and display it in this
-- window. If no window argument is passed, the routine will create
-- a temporary window and use it.
function Filter_Key return Real_Key_Code;
procedure Unknown_Key;
procedure Redo;
procedure To_Window (C : in out Help_Line_Access;
More : in out Boolean);
Frame : Window := Null_Window;
W : Window := Win;
K : Real_Key_Code;
P : Panel;
Height : Line_Count;
Width : Column_Count;
Help : Help_Line_Access := Search (Key);
Current : Help_Line_Access;
Top_Line : Help_Line_Access;
Has_More : Boolean := True;
procedure Unknown_Key
is
begin
Add (W, "Help message with ID ");
Add (W, Key);
Add (W, " not found.");
Add (W, Character'Val (10));
Add (W, "Press the Function key labelled 'Quit' key to continue.");
end Unknown_Key;
procedure Redo
is
H : Help_Line_Access := Top_Line;
begin
if Top_Line /= null then
for L in 0 .. (Height - 1) loop
Add (W, L, 0, H.Line.all);
exit when H.Next = null;
H := H.Next;
end loop;
else
Unknown_Key;
end if;
end Redo;
function Filter_Key return Real_Key_Code
is
K : Real_Key_Code;
begin
loop
K := Get_Key (W);
if K in Special_Key_Code'Range then
case K is
when HELP_CODE =>
if not Find_Context (In_Help) then
Push_Environment (In_Help, False);
Explain (In_Help, W);
Pop_Environment;
Redo;
end if;
when EXPLAIN_CODE =>
if not Find_Context (Help_Keys) then
Push_Environment (Help_Keys, False);
Explain (Help_Keys, W);
Pop_Environment;
Redo;
end if;
when others => exit;
end case;
else
exit;
end if;
end loop;
return K;
end Filter_Key;
procedure To_Window (C : in out Help_Line_Access;
More : in out Boolean)
is
L : Line_Position := 0;
begin
loop
Add (W, L, 0, C.Line.all);
L := L + 1;
exit when C.Next = null or else L = Height;
C := C.Next;
end loop;
if C.Next /= null then
pragma Assert (L = Height);
More := True;
else
More := False;
end if;
end To_Window;
begin
if W = Null_Window then
Push_Environment ("HELP");
Default_Labels;
Frame := New_Window (Lines - 2, Columns, 0, 0);
if Has_Colors then
Set_Background (Win => Frame,
Ch => (Ch => ' ',
Color => Help_Color,
Attr => Normal_Video));
Set_Character_Attributes (Win => Frame,
Attr => Normal_Video,
Color => Help_Color);
Erase (Frame);
end if;
Box (Frame);
Set_Character_Attributes (Frame, (Reverse_Video => True,
others => False));
Add (Frame, Lines - 3, 2, "Cursor Up/Down scrolls");
Set_Character_Attributes (Frame); -- Back to default.
Window_Title (Frame, "Explanation");
W := Derived_Window (Frame, Lines - 4, Columns - 2, 1, 1);
Refresh_Without_Update (Frame);
Get_Size (W, Height, Width);
Set_Meta_Mode (W);
Set_KeyPad_Mode (W);
Allow_Scrolling (W, True);
Set_Echo_Mode (False);
P := Create (Frame);
Top (P);
Update_Panels;
else
Clear (W);
Refresh_Without_Update (W);
end if;
Current := Help; Top_Line := Help;
if null = Help then
Unknown_Key;
loop
K := Filter_Key;
exit when K = QUIT_CODE;
end loop;
else
To_Window (Current, Has_More);
if Has_More then
-- This means there are more lines available, so we have to go
-- into a scroll manager.
loop
K := Filter_Key;
if K in Special_Key_Code'Range then
case K is
when Key_Cursor_Down =>
if Current.Next /= null then
Move_Cursor (W, Height - 1, 0);
Scroll (W, 1);
Current := Current.Next;
Top_Line := Top_Line.Next;
Add (W, Current.Line.all);
end if;
when Key_Cursor_Up =>
if Top_Line.Prev /= null then
Move_Cursor (W, 0, 0);
Scroll (W, -1);
Top_Line := Top_Line.Prev;
Current := Current.Prev;
Add (W, Top_Line.Line.all);
end if;
when QUIT_CODE => exit;
when others => null;
end case;
end if;
end loop;
else
loop
K := Filter_Key;
exit when K = QUIT_CODE;
end loop;
end if;
end if;
Clear (W);
if Frame /= Null_Window then
Clear (Frame);
Delete (P);
Delete (W);
Delete (Frame);
Pop_Environment;
end if;
Update_Panels;
Update_Screen;
Release_Help (Help);
end Explain;
function Search (Key : String) return Help_Line_Access
is
Last : Natural;
Buffer : String (1 .. 256);
Root : Help_Line_Access := null;
Current : Help_Line_Access;
Tail : Help_Line_Access := null;
function Next_Line return Boolean;
function Next_Line return Boolean
is
H_End : constant String := "#END";
begin
Get_Line (F, Buffer, Last);
if Last = H_End'Length and then H_End = Buffer (1 .. Last) then
return False;
else
return True;
end if;
end Next_Line;
begin
Reset (F);
Outer :
loop
exit Outer when not Next_Line;
if Last = (1 + Key'Length) and then Key = Buffer (2 .. Last)
and then Buffer (1) = '#' then
loop
exit when not Next_Line;
exit when Buffer (1) = '#';
Current := new Help_Line'(null, null,
new String'(Buffer (1 .. Last)));
if Tail = null then
Release_Help (Root);
Root := Current;
else
Tail.Next := Current;
Current.Prev := Tail;
end if;
Tail := Current;
end loop;
exit Outer;
end if;
end loop Outer;
return Root;
end Search;
procedure Release_Help (Root : in out Help_Line_Access)
is
Next : Help_Line_Access;
begin
loop
exit when Root = null;
Next := Root.Next;
Release_String (Root.Line);
Release_Help_Line (Root);
Root := Next;
end loop;
end Release_Help;
procedure Explain_Context
is
begin
Explain (Context);
end Explain_Context;
procedure Notepad (Key : String)
is
H : constant Help_Line_Access := Search (Key);
T : Help_Line_Access := H;
N : Line_Count := 1;
L : Line_Position := 0;
W : Window;
P : Panel;
begin
if H /= null then
loop
T := T.Next;
exit when T = null;
N := N + 1;
end loop;
W := New_Window (N + 2, Columns, Lines - N - 2, 0);
if Has_Colors then
Set_Background (Win => W,
Ch => (Ch => ' ',
Color => Notepad_Color,
Attr => Normal_Video));
Set_Character_Attributes (Win => W,
Attr => Normal_Video,
Color => Notepad_Color);
Erase (W);
end if;
Box (W);
Window_Title (W, "Notepad");
P := New_Panel (W);
T := H;
loop
Add (W, L + 1, 1, T.Line.all, Integer (Columns - 2));
L := L + 1;
T := T.Next;
exit when T = null;
end loop;
T := H;
Release_Help (T);
Refresh_Without_Update (W);
Notepad_To_Context (P);
end if;
end Notepad;
begin
Open (F, In_File, File_Name);
end Sample.Explanation;

59
Ada95/samples/sample-explanation.ads Normal file
View File

@ -0,0 +1,59 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Explanation --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.11 $
-- Binding Version 01.00
------------------------------------------------------------------------------
-- Poor mans help system. This scans a sequential file for key lines and
-- then reads the lines up to the next key. Those lines are presented in
-- a window as help or explanation.
--
package Sample.Explanation is
procedure Explain (Key : String);
-- Retrieve the text associated with this key and display it.
procedure Explain_Context;
-- Explain the current context.
procedure Notepad (Key : String);
-- Put a note on the screen and maintain it with the context
Explanation_Not_Found : exception;
Explanation_Error : exception;
end Sample.Explanation;

263
Ada95/samples/sample-form_demo-aux.adb Normal file
View File

@ -0,0 +1,263 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Form_Demo.Aux --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2004,2009 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.17 $
-- $Date: 2009/12/26 17:38:58 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Sample.Manifest; use Sample.Manifest;
with Sample.Helpers; use Sample.Helpers;
with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
with Sample.Explanation; use Sample.Explanation;
package body Sample.Form_Demo.Aux is
procedure Geometry (F : Form;
L : out Line_Count; -- Lines used for menu
C : out Column_Count; -- Columns used for menu
Y : out Line_Position; -- Proposed Line for menu
X : out Column_Position) -- Proposed Column for menu
is
begin
Scale (F, L, C);
L := L + 2; -- count for frame at top and bottom
C := C + 2; -- "
-- Calculate horizontal coordinate at the screen center
X := (Columns - C) / 2;
Y := 1; -- start always in line 1
end Geometry;
function Create (F : Form;
Title : String;
Lin : Line_Position;
Col : Column_Position) return Panel
is
W, S : Window;
L : Line_Count;
C : Column_Count;
Y : Line_Position;
X : Column_Position;
Pan : Panel;
begin
Geometry (F, L, C, Y, X);
W := New_Window (L, C, Lin, Col);
Set_Meta_Mode (W);
Set_KeyPad_Mode (W);
if Has_Colors then
Set_Background (Win => W,
Ch => (Ch => ' ',
Color => Default_Colors,
Attr => Normal_Video));
Set_Character_Attributes (Win => W,
Color => Default_Colors,
Attr => Normal_Video);
Erase (W);
end if;
S := Derived_Window (W, L - 2, C - 2, 1, 1);
Set_Meta_Mode (S);
Set_KeyPad_Mode (S);
Box (W);
Set_Window (F, W);
Set_Sub_Window (F, S);
if Title'Length > 0 then
Window_Title (W, Title);
end if;
Pan := New_Panel (W);
Post (F);
return Pan;
end Create;
procedure Destroy (F : Form;
P : in out Panel)
is
W, S : Window;
begin
W := Get_Window (F);
S := Get_Sub_Window (F);
Post (F, False);
Erase (W);
Delete (P);
Set_Window (F, Null_Window);
Set_Sub_Window (F, Null_Window);
Delete (S);
Delete (W);
Update_Panels;
end Destroy;
function Get_Request (F : Form;
P : Panel;
Handle_CRLF : Boolean := True) return Key_Code
is
W : constant Window := Get_Window (F);
K : Real_Key_Code;
Ch : Character;
begin
Top (P);
loop
K := Get_Key (W);
if K in Special_Key_Code'Range then
case K is
when HELP_CODE => Explain_Context;
when EXPLAIN_CODE => Explain ("FORMKEYS");
when Key_Home => return F_First_Field;
when Key_End => return F_Last_Field;
when QUIT_CODE => return QUIT;
when Key_Cursor_Down => return F_Down_Char;
when Key_Cursor_Up => return F_Up_Char;
when Key_Cursor_Left => return F_Previous_Char;
when Key_Cursor_Right => return F_Next_Char;
when Key_Next_Page => return F_Next_Page;
when Key_Previous_Page => return F_Previous_Page;
when Key_Backspace => return F_Delete_Previous;
when Key_Clear_Screen => return F_Clear_Field;
when Key_Clear_End_Of_Line => return F_Clear_EOF;
when others => return K;
end case;
elsif K in Normal_Key_Code'Range then
Ch := Character'Val (K);
case Ch is
when CAN => return QUIT; -- CTRL-X
when ACK => return F_Next_Field; -- CTRL-F
when STX => return F_Previous_Field; -- CTRL-B
when FF => return F_Left_Field; -- CTRL-L
when DC2 => return F_Right_Field; -- CTRL-R
when NAK => return F_Up_Field; -- CTRL-U
when EOT => return F_Down_Field; -- CTRL-D
when ETB => return F_Next_Word; -- CTRL-W
when DC4 => return F_Previous_Word; -- CTRL-T
when SOH => return F_Begin_Field; -- CTRL-A
when ENQ => return F_End_Field; -- CTRL-E
when HT => return F_Insert_Char; -- CTRL-I
when SI => return F_Insert_Line; -- CTRL-O
when SYN => return F_Delete_Char; -- CTRL-V
when BS => return F_Delete_Previous; -- CTRL-H
when EM => return F_Delete_Line; -- CTRL-Y
when BEL => return F_Delete_Word; -- CTRL-G
when VT => return F_Clear_EOF; -- CTRL-K
when SO => return F_Next_Choice; -- CTRL-N
when DLE => return F_Previous_Choice; -- CTRL-P
when CR | LF =>
if Handle_CRLF then
return F_New_Line;
else
return K;
end if;
when others => return K;
end case;
else
return K;
end if;
end loop;
end Get_Request;
function Make (Top : Line_Position;
Left : Column_Position;
Text : String) return Field
is
Fld : Field;
C : constant Column_Count := Column_Count (Text'Length);
begin
Fld := New_Field (1, C, Top, Left);
Set_Buffer (Fld, 0, Text);
Switch_Options (Fld, (Active => True, others => False), False);
if Has_Colors then
Set_Background (Fld => Fld, Color => Default_Colors);
end if;
return Fld;
end Make;
function Make (Height : Line_Count := 1;
Width : Column_Count;
Top : Line_Position;
Left : Column_Position;
Off_Screen : Natural := 0) return Field
is
Fld : constant Field := New_Field (Height, Width, Top, Left, Off_Screen);
begin
if Has_Colors then
Set_Foreground (Fld => Fld, Color => Form_Fore_Color);
Set_Background (Fld => Fld, Color => Form_Back_Color);
else
Set_Background (Fld, (Reverse_Video => True, others => False));
end if;
return Fld;
end Make;
function Default_Driver (F : Form;
K : Key_Code;
P : Panel) return Boolean
is
begin
if P = Null_Panel then
raise Panel_Exception;
end if;
if K in User_Key_Code'Range and then K = QUIT then
if Driver (F, F_Validate_Field) = Form_Ok then
return True;
end if;
end if;
return False;
end Default_Driver;
function Count_Active (F : Form) return Natural
is
N : Natural := 0;
O : Field_Option_Set;
H : constant Natural := Field_Count (F);
begin
if H > 0 then
for I in 1 .. H loop
Get_Options (Fields (F, I), O);
if O.Active then
N := N + 1;
end if;
end loop;
end if;
return N;
end Count_Active;
end Sample.Form_Demo.Aux;

92
Ada95/samples/sample-form_demo-aux.ads Normal file
View File

@ -0,0 +1,92 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Form_Demo.Aux --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.10 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
with Terminal_Interface.Curses.Forms; use Terminal_Interface.Curses.Forms;
package Sample.Form_Demo.Aux is
procedure Geometry (F : Form;
L : out Line_Count;
C : out Column_Count;
Y : out Line_Position;
X : out Column_Position);
-- Calculate the geometry for a panel beeing able to be used to display
-- the menu.
function Create (F : Form;
Title : String;
Lin : Line_Position;
Col : Column_Position) return Panel;
-- Create a panel decorated with a frame and the title at the specified
-- position. The dimension of the panel is derived from the menus layout.
procedure Destroy (F : Form;
P : in out Panel);
-- Destroy all the windowing structures associated with this menu and
-- panel.
function Get_Request (F : Form;
P : Panel;
Handle_CRLF : Boolean := True) return Key_Code;
-- Centralized request driver for all menus in this sample. This
-- gives us a common key binding for all menus.
function Make (Top : Line_Position;
Left : Column_Position;
Text : String) return Field;
-- create a label
function Make (Height : Line_Count := 1;
Width : Column_Count;
Top : Line_Position;
Left : Column_Position;
Off_Screen : Natural := 0) return Field;
-- create a editable field
function Default_Driver (F : Form;
K : Key_Code;
P : Panel) return Boolean;
function Count_Active (F : Form) return Natural;
-- Count the number of active fields in the form
end Sample.Form_Demo.Aux;

98
Ada95/samples/sample-form_demo-handler.adb Normal file
View File

@ -0,0 +1,98 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Form_Demo.Handler --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2004,2009 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.14 $
-- $Date: 2009/12/26 17:38:58 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Sample.Form_Demo.Aux;
package body Sample.Form_Demo.Handler is
package Aux renames Sample.Form_Demo.Aux;
procedure Drive_Me (F : Form;
Title : String := "")
is
L : Line_Count;
C : Column_Count;
Y : Line_Position;
X : Column_Position;
begin
Aux.Geometry (F, L, C, Y, X);
Drive_Me (F, Y, X, Title);
end Drive_Me;
procedure Drive_Me (F : Form;
Lin : Line_Position;
Col : Column_Position;
Title : String := "")
is
Pan : Panel := Aux.Create (F, Title, Lin, Col);
V : Cursor_Visibility := Normal;
Handle_CRLF : Boolean := True;
begin
Set_Cursor_Visibility (V);
if Aux.Count_Active (F) = 1 then
Handle_CRLF := False;
end if;
loop
declare
K : constant Key_Code := Aux.Get_Request (F, Pan, Handle_CRLF);
R : Driver_Result;
begin
if (K = 13 or else K = 10) and then not Handle_CRLF then
R := Unknown_Request;
else
R := Driver (F, K);
end if;
case R is
when Form_Ok => null;
when Unknown_Request =>
if My_Driver (F, K, Pan) then
exit;
end if;
when others => Beep;
end case;
end;
end loop;
Set_Cursor_Visibility (V);
Aux.Destroy (F, Pan);
end Drive_Me;
end Sample.Form_Demo.Handler;

64
Ada95/samples/sample-form_demo-handler.ads Normal file
View File

@ -0,0 +1,64 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Form_Demo.Handler --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.10 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses;
use Terminal_Interface.Curses;
with Terminal_Interface.Curses.Panels;
use Terminal_Interface.Curses.Panels;
with Terminal_Interface.Curses.Forms;
use Terminal_Interface.Curses.Forms;
generic
with function My_Driver (Frm : Form;
K : Key_Code;
Pan : Panel) return Boolean;
package Sample.Form_Demo.Handler is
procedure Drive_Me (F : Form;
Lin : Line_Position;
Col : Column_Position;
Title : String := "");
-- Position the menu at the given point and drive it.
procedure Drive_Me (F : Form;
Title : String := "");
-- Center menu and drive it.
end Sample.Form_Demo.Handler;

130
Ada95/samples/sample-form_demo.adb Normal file
View File

@ -0,0 +1,130 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Form_Demo --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2004,2006 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.15 $
-- $Date: 2006/06/25 14:30:22 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Terminal_Interface.Curses.Forms; use Terminal_Interface.Curses.Forms;
with Terminal_Interface.Curses.Forms.Field_User_Data;
with Sample.My_Field_Type; use Sample.My_Field_Type;
with Sample.Explanation; use Sample.Explanation;
with Sample.Form_Demo.Aux; use Sample.Form_Demo.Aux;
with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
with Sample.Form_Demo.Handler;
with Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada;
with Terminal_Interface.Curses.Forms.Field_Types.Enumeration;
use Terminal_Interface.Curses.Forms.Field_Types.Enumeration;
with Terminal_Interface.Curses.Forms.Field_Types.IntField;
use Terminal_Interface.Curses.Forms.Field_Types.IntField;
package body Sample.Form_Demo is
type User_Data is
record
Data : Integer;
end record;
type User_Access is access User_Data;
package Fld_U is new
Terminal_Interface.Curses.Forms.Field_User_Data (User_Data,
User_Access);
type Weekday is (Sunday, Monday, Tuesday, Wednesday, Thursday,
Friday, Saturday);
package Weekday_Enum is new
Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada (Weekday);
Enum_Field : constant Enumeration_Field :=
Weekday_Enum.Create;
procedure Demo
is
Mft : constant My_Data := (Ch => 'X');
FA : Field_Array_Access := new Field_Array'
(Make (0, 14, "Sample Entry Form"),
Make (2, 0, "WeekdayEnumeration"),
Make (2, 20, "Numeric 1-10"),
Make (2, 34, "Only 'X'"),
Make (5, 0, "Multiple Lines offscreen(Scroll)"),
Make (Width => 18, Top => 3, Left => 0),
Make (Width => 12, Top => 3, Left => 20),
Make (Width => 12, Top => 3, Left => 34),
Make (Width => 46, Top => 6, Left => 0, Height => 4, Off_Screen => 2),
Null_Field
);
Frm : Terminal_Interface.Curses.Forms.Form := Create (FA);
I_F : constant Integer_Field := (Precision => 0,
Lower_Limit => 1,
Upper_Limit => 10);
F1, F2 : User_Access;
package Fh is new Sample.Form_Demo.Handler (Default_Driver);
begin
Push_Environment ("FORM00");
Notepad ("FORM-PAD00");
Default_Labels;
Set_Field_Type (FA (6), Enum_Field);
Set_Field_Type (FA (7), I_F);
Set_Field_Type (FA (8), Mft);
F1 := new User_Data'(Data => 4711);
Fld_U.Set_User_Data (FA (1), F1);
Fh.Drive_Me (Frm);
Fld_U.Get_User_Data (FA (1), F2);
pragma Assert (F1 = F2);
pragma Assert (F1.Data = F2.Data);
Pop_Environment;
Delete (Frm);
Free (FA, True);
end Demo;
end Sample.Form_Demo;

45
Ada95/samples/sample-form_demo.ads Normal file
View File

@ -0,0 +1,45 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Form_Demo --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.9 $
-- Binding Version 01.00
------------------------------------------------------------------------------
package Sample.Form_Demo is
procedure Demo;
end Sample.Form_Demo;

214
Ada95/samples/sample-function_key_setting.adb Normal file
View File

@ -0,0 +1,214 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Function_Key_Setting --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2004,2009 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.14 $
-- $Date: 2009/12/26 17:38:58 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with Sample.Manifest; use Sample.Manifest;
-- This package implements a simple stack of function key label environments.
--
package body Sample.Function_Key_Setting is
Max_Label_Length : constant Positive := 8;
Number_Of_Keys : Label_Number := Label_Number'Last;
Justification : Label_Justification := Left;
subtype Label is String (1 .. Max_Label_Length);
type Label_Array is array (Label_Number range <>) of Label;
type Key_Environment (N : Label_Number := Label_Number'Last);
type Env_Ptr is access Key_Environment;
pragma Controlled (Env_Ptr);
type String_Access is access String;
pragma Controlled (String_Access);
Active_Context : String_Access := new String'("MAIN");
Active_Notepad : Panel := Null_Panel;
type Key_Environment (N : Label_Number := Label_Number'Last) is
record
Prev : Env_Ptr;
Help : String_Access;
Notepad : Panel;
Labels : Label_Array (1 .. N);
end record;
procedure Release_String is
new Ada.Unchecked_Deallocation (String,
String_Access);
procedure Release_Environment is
new Ada.Unchecked_Deallocation (Key_Environment,
Env_Ptr);
Top_Of_Stack : Env_Ptr := null;
procedure Push_Environment (Key : String;
Reset : Boolean := True)
is
P : constant Env_Ptr := new Key_Environment (Number_Of_Keys);
begin
-- Store the current labels in the environment
for I in 1 .. Number_Of_Keys loop
Get_Soft_Label_Key (I, P.Labels (I));
if Reset then
Set_Soft_Label_Key (I, " ");
end if;
end loop;
P.Prev := Top_Of_Stack;
-- now store active help context and notepad
P.Help := Active_Context;
P.Notepad := Active_Notepad;
-- The notepad must now vanish and the new notepad is empty.
if P.Notepad /= Null_Panel then
Hide (P.Notepad);
Update_Panels;
end if;
Active_Notepad := Null_Panel;
Active_Context := new String'(Key);
Top_Of_Stack := P;
if Reset then
Refresh_Soft_Label_Keys_Without_Update;
end if;
end Push_Environment;
procedure Pop_Environment
is
P : Env_Ptr := Top_Of_Stack;
begin
if Top_Of_Stack = null then
raise Function_Key_Stack_Error;
else
for I in 1 .. Number_Of_Keys loop
Set_Soft_Label_Key (I, P.Labels (I), Justification);
end loop;
pragma Assert (Active_Context /= null);
Release_String (Active_Context);
Active_Context := P.Help;
Refresh_Soft_Label_Keys_Without_Update;
Notepad_To_Context (P.Notepad);
Top_Of_Stack := P.Prev;
Release_Environment (P);
end if;
end Pop_Environment;
function Context return String
is
begin
if Active_Context /= null then
return Active_Context.all;
else
return "";
end if;
end Context;
function Find_Context (Key : String) return Boolean
is
P : Env_Ptr := Top_Of_Stack;
begin
if Active_Context.all = Key then
return True;
else
loop
exit when P = null;
if P.Help.all = Key then
return True;
else
P := P.Prev;
end if;
end loop;
return False;
end if;
end Find_Context;
procedure Notepad_To_Context (Pan : Panel)
is
W : Window;
begin
if Active_Notepad /= Null_Panel then
W := Get_Window (Active_Notepad);
Clear (W);
Delete (Active_Notepad);
Delete (W);
end if;
Active_Notepad := Pan;
if Pan /= Null_Panel then
Top (Pan);
end if;
Update_Panels;
Update_Screen;
end Notepad_To_Context;
procedure Initialize (Mode : Soft_Label_Key_Format := PC_Style;
Just : Label_Justification := Left)
is
begin
case Mode is
when PC_Style .. PC_Style_With_Index
=> Number_Of_Keys := 12;
when others
=> Number_Of_Keys := 8;
end case;
Init_Soft_Label_Keys (Mode);
Justification := Just;
end Initialize;
procedure Default_Labels
is
begin
Set_Soft_Label_Key (FKEY_QUIT, "Quit");
Set_Soft_Label_Key (FKEY_HELP, "Help");
Set_Soft_Label_Key (FKEY_EXPLAIN, "Keys");
Refresh_Soft_Label_Keys_Without_Update;
end Default_Labels;
function Notepad_Window return Window
is
begin
if Active_Notepad /= Null_Panel then
return Get_Window (Active_Notepad);
else
return Null_Window;
end if;
end Notepad_Window;
end Sample.Function_Key_Setting;

82
Ada95/samples/sample-function_key_setting.ads Normal file
View File

@ -0,0 +1,82 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Function_Key_Setting --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.10 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
-- This package implements a simple stack of function key label environments.
--
package Sample.Function_Key_Setting is
procedure Push_Environment (Key : String;
Reset : Boolean := True);
-- Push the definition of the current function keys on an internal
-- stack. If the reset flag is true, all labels are reset while
-- pushed, so the new environment can assume a tabula rasa.
-- The Key defines the new Help Context associated with the new
-- Environment. This saves also the currently active Notepad.
procedure Pop_Environment;
-- Pop the Definitions from the stack and make them the current ones.
-- This also restores the Help context and the previous Notepad.
procedure Initialize (Mode : Soft_Label_Key_Format := PC_Style;
Just : Label_Justification := Left);
-- Initialize the environment
function Context return String;
-- Return the current context identitfier
function Find_Context (Key : String) return Boolean;
-- Look for a context, return true if it is in the stack,
-- false otherwise.
procedure Notepad_To_Context (Pan : Panel);
-- Add a panel representing a notepad to the current context.
Function_Key_Stack_Error : exception;
procedure Default_Labels;
-- Set the default labels used in all environments
function Notepad_Window return Window;
-- Return the current notepad window or Null_Window if there is none.
end Sample.Function_Key_Setting;

180
Ada95/samples/sample-header_handler.adb Normal file
View File

@ -0,0 +1,180 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Header_Handler --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2006,2009 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.17 $
-- $Date: 2009/12/26 17:38:58 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Calendar; use Ada.Calendar;
with Terminal_Interface.Curses.Text_IO.Integer_IO;
with Sample.Manifest; use Sample.Manifest;
-- This package handles the painting of the header line of the screen.
--
package body Sample.Header_Handler is
package Int_IO is new
Terminal_Interface.Curses.Text_IO.Integer_IO (Integer);
use Int_IO;
Header_Window : Window := Null_Window;
Display_Hour : Integer := -1; -- hour last displayed
Display_Min : Integer := -1; -- minute last displayed
Display_Day : Integer := -1; -- day last displayed
Display_Month : Integer := -1; -- month last displayed
-- This is the routine handed over to the curses library to be called
-- as initialization routine when ripping of the header lines from
-- the screen. This routine must follow C conventions.
function Init_Header_Window (Win : Window;
Columns : Column_Count) return Integer;
pragma Convention (C, Init_Header_Window);
procedure Internal_Update_Header_Window (Do_Update : Boolean);
-- The initialization must be called before Init_Screen. It steals two
-- lines from the top of the screen.
procedure Init_Header_Handler
is
begin
Rip_Off_Lines (2, Init_Header_Window'Access);
end Init_Header_Handler;
procedure N_Out (N : Integer);
-- Emit a two digit number and ensure that a leading zero is generated if
-- necessary.
procedure N_Out (N : Integer)
is
begin
if N < 10 then
Add (Header_Window, '0');
Put (Header_Window, N, 1);
else
Put (Header_Window, N, 2);
end if;
end N_Out;
-- Paint the header window. The input parameter is a flag indicating
-- whether or not the screen should be updated physically after painting.
procedure Internal_Update_Header_Window (Do_Update : Boolean)
is
type Month_Name_Array is
array (Month_Number'First .. Month_Number'Last) of String (1 .. 9);
Month_Names : constant Month_Name_Array :=
("January ",
"February ",
"March ",
"April ",
"May ",
"June ",
"July ",
"August ",
"September",
"October ",
"November ",
"December ");
Now : constant Time := Clock;
Sec : constant Integer := Integer (Seconds (Now));
Hour : constant Integer := Sec / 3600;
Minute : constant Integer := (Sec - Hour * 3600) / 60;
Mon : constant Month_Number := Month (Now);
D : constant Day_Number := Day (Now);
begin
if Header_Window /= Null_Window then
if Minute /= Display_Min or else Hour /= Display_Hour
or else Display_Day /= D or else Display_Month /= Mon then
Move_Cursor (Header_Window, 0, 0);
N_Out (D); Add (Header_Window, '.');
Add (Header_Window, Month_Names (Mon));
Move_Cursor (Header_Window, 1, 0);
N_Out (Hour); Add (Header_Window, ':');
N_Out (Minute);
Display_Min := Minute;
Display_Hour := Hour;
Display_Month := Mon;
Display_Day := D;
Refresh_Without_Update (Header_Window);
if Do_Update then
Update_Screen;
end if;
end if;
end if;
end Internal_Update_Header_Window;
-- This routine is called in the keyboard input timeout handler. So it will
-- periodically update the header line of the screen.
procedure Update_Header_Window
is
begin
Internal_Update_Header_Window (True);
end Update_Header_Window;
function Init_Header_Window (Win : Window;
Columns : Column_Count) return Integer
is
Title : constant String := "Ada 95 ncurses Binding Sample";
Pos : Column_Position;
begin
Header_Window := Win;
if Win /= Null_Window then
if Has_Colors then
Set_Background (Win => Win,
Ch => (Ch => ' ',
Color => Header_Color,
Attr => Normal_Video));
Set_Character_Attributes (Win => Win,
Attr => Normal_Video,
Color => Header_Color);
Erase (Win);
end if;
Leave_Cursor_After_Update (Win, True);
Pos := Columns - Column_Position (Title'Length);
Add (Win, 0, Pos / 2, Title);
-- In this phase we must not allow a physical update, because
-- ncurses isn´t properly initialized at this point.
Internal_Update_Header_Window (False);
return 0;
else
return -1;
end if;
end Init_Header_Window;
end Sample.Header_Handler;

53
Ada95/samples/sample-header_handler.ads Normal file
View File

@ -0,0 +1,53 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Header_Handler --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.9 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
-- This package handles the painting of the header line of the screen.
--
package Sample.Header_Handler is
procedure Init_Header_Handler;
-- Initialize the handler for the headerlines.
procedure Update_Header_Window;
-- Update the information in the header window
end Sample.Header_Handler;

68
Ada95/samples/sample-helpers.adb Normal file
View File

@ -0,0 +1,68 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Helpers --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2008,2009 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.13 $
-- $Date: 2009/12/26 17:38:58 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Sample.Explanation; use Sample.Explanation;
-- This package contains some conveniant helper routines used throughout
-- this example.
--
package body Sample.Helpers is
procedure Window_Title (Win : Window;
Title : String)
is
Height : Line_Count;
Width : Column_Count;
Pos : Column_Position := 0;
begin
Get_Size (Win, Height, Width);
if Title'Length < Width then
Pos := (Width - Title'Length) / 2;
end if;
Add (Win, 0, Pos, Title);
end Window_Title;
procedure Not_Implemented is
begin
Explain ("NOTIMPL");
end Not_Implemented;
end Sample.Helpers;

54
Ada95/samples/sample-helpers.ads Normal file
View File

@ -0,0 +1,54 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Helpers --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.10 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
-- This package contains some conveniant helper routines used throughout
-- this example.
--
package Sample.Helpers is
procedure Window_Title (Win : Window;
Title : String);
-- Put a title string into the first line of the window
procedure Not_Implemented;
end Sample.Helpers;

194
Ada95/samples/sample-keyboard_handler.adb Normal file
View File

@ -0,0 +1,194 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Keyboard_Handler --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2004,2006 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.14 $
-- $Date: 2006/06/25 14:30:22 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Strings; use Ada.Strings;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
with Terminal_Interface.Curses.Forms; use Terminal_Interface.Curses.Forms;
with Terminal_Interface.Curses.Forms.Field_Types.Enumeration;
use Terminal_Interface.Curses.Forms.Field_Types.Enumeration;
with Sample.Header_Handler; use Sample.Header_Handler;
with Sample.Form_Demo.Aux; use Sample.Form_Demo.Aux;
with Sample.Manifest; use Sample.Manifest;
with Sample.Form_Demo.Handler;
-- This package contains a centralized keyboard handler used throughout
-- this example. The handler establishes a timeout mechanism that provides
-- periodical updates of the common header lines used in this example.
--
package body Sample.Keyboard_Handler is
In_Command : Boolean := False;
function Get_Key (Win : Window := Standard_Window) return Real_Key_Code
is
K : Real_Key_Code;
function Command return Real_Key_Code;
function Command return Real_Key_Code
is
function My_Driver (F : Form;
C : Key_Code;
P : Panel) return Boolean;
package Fh is new Sample.Form_Demo.Handler (My_Driver);
type Label_Array is array (Label_Number) of String (1 .. 8);
Labels : Label_Array;
FA : Field_Array_Access := new Field_Array'
(Make (0, 0, "Command:"),
Make (Top => 0, Left => 9, Width => Columns - 11),
Null_Field);
K : Real_Key_Code := Key_None;
N : Natural := 0;
function My_Driver (F : Form;
C : Key_Code;
P : Panel) return Boolean
is
Ch : Character;
begin
if P = Null_Panel then
raise Panel_Exception;
end if;
if C in User_Key_Code'Range and then C = QUIT then
if Driver (F, F_Validate_Field) = Form_Ok then
K := Key_None;
return True;
end if;
elsif C in Normal_Key_Code'Range then
Ch := Character'Val (C);
if Ch = LF or else Ch = CR then
if Driver (F, F_Validate_Field) = Form_Ok then
declare
Buffer : String (1 .. Positive (Columns - 11));
Cmdc : String (1 .. 8);
begin
Get_Buffer (Fld => FA (2), Str => Buffer);
Trim (Buffer, Left);
if Buffer (1) /= ' ' then
Cmdc := To_Upper (Buffer (Cmdc'Range));
for I in Labels'Range loop
if Cmdc = Labels (I) then
K := Function_Key_Code
(Function_Key_Number (I));
exit;
end if;
end loop;
end if;
return True;
end;
end if;
end if;
end if;
return False;
end My_Driver;
begin
In_Command := True;
for I in Label_Number'Range loop
Get_Soft_Label_Key (I, Labels (I));
Trim (Labels (I), Left);
Translate (Labels (I), Upper_Case_Map);
if Labels (I) (1) /= ' ' then
N := N + 1;
end if;
end loop;
if N > 0 then -- some labels were really set
declare
Enum_Info : Enumeration_Info (N);
Enum_Field : Enumeration_Field;
J : Positive := Enum_Info.Names'First;
Frm : Form := Create (FA);
begin
for I in Label_Number'Range loop
if Labels (I) (1) /= ' ' then
Enum_Info.Names (J) := new String'(Labels (I));
J := J + 1;
end if;
end loop;
Enum_Field := Create (Enum_Info, True);
Set_Field_Type (FA (2), Enum_Field);
Set_Background (FA (2), Normal_Video);
Fh.Drive_Me (Frm, Lines - 3, 0);
Delete (Frm);
Update_Panels; Update_Screen;
end;
end if;
Free (FA, True);
In_Command := False;
return K;
end Command;
begin
Set_Timeout_Mode (Win, Delayed, 30000);
loop
K := Get_Keystroke (Win);
if K = Key_None then -- a timeout occured
Update_Header_Window;
elsif K = 3 and then not In_Command then -- CTRL-C
K := Command;
exit when K /= Key_None;
else
exit;
end if;
end loop;
return K;
end Get_Key;
procedure Init_Keyboard_Handler is
begin
null;
end Init_Keyboard_Handler;
end Sample.Keyboard_Handler;

Some files were not shown because too many files have changed in this diff Show More