Import a stock copy of ncurses 5.8 into the vendor space.
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:
parent
22b11c4db1
commit
0294a182a1
Notes:
svn2git
2020-12-20 02:59:44 +00:00
svn path=/vendor/ncurses/dist/; revision=221243 svn path=/vendor/ncurses/5.8-20110226/; revision=221244; tag=vendor/ncurses/5.8-20110226
590
ANNOUNCE
590
ANNOUNCE
@ -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
81
Ada95/Makefile.in
Normal 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
33
Ada95/README
Normal 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
55
Ada95/TODO
Normal 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
3458
Ada95/aclocal.m4
vendored
Normal file
File diff suppressed because it is too large
Load Diff
12189
Ada95/configure
vendored
Executable file
12189
Ada95/configure
vendored
Executable file
File diff suppressed because it is too large
Load Diff
626
Ada95/configure.in
Normal file
626
Ada95/configure.in
Normal 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
449
Ada95/gen/Makefile.in
Normal 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%<A HREF%<A HREF%g' |\
|
||||
sed -e 's%">%">%g' |\
|
||||
sed -e 's/3X/3x/g' |\
|
||||
sed -e 's/$$\([ABCDEFGHIJKLMNOPQRSTUVWXZabcdefghijklmnopqrstuvwxz0123456789_]*:.*\)\$$/@\1@/' |\
|
||||
sed -e 's%</A>%</A>%g' > $$a.tmp ;\
|
||||
mv $$a.tmp $$f ;\
|
||||
done
|
||||
@rm -f *.ad[sb] *.ali *.tmp
|
||||
@for f in funcs.htm main.htm ; do \
|
||||
sed -e "\%<A HREF=funcs/ .htm>\[ \]</A>%d" < html/$$f > $$f ;\
|
||||
mv $$f html/$$f ;\
|
||||
done
|
||||
@rm -f "html/funcs/ .htm"
|
||||
@cp -pdrf html/* $(HTML_DIR)/
|
||||
@rm -rf html
|
||||
|
||||
html : adahtml $(HTML_DIR)/table.html
|
||||
@echo made $@
|
||||
|
||||
###############################################################################
|
||||
# The remainder of this file is automatically generated during configuration
|
||||
###############################################################################
|
79
Ada95/gen/adacurses-config.in
Normal file
79
Ada95/gen/adacurses-config.in
Normal 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
1537
Ada95/gen/gen.c
Normal file
File diff suppressed because it is too large
Load Diff
40
Ada95/gen/html.m4
Normal file
40
Ada95/gen/html.m4
Normal 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
37
Ada95/gen/normal.m4
Normal 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
35
Ada95/gen/table.m4
Normal 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
105
Ada95/gen/terminal_interface-curses-aux.ads.m4
Normal 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
238
Ada95/gen/terminal_interface-curses-forms-field_types.ads.m4
Normal 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;
|
@ -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;
|
@ -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
699
Ada95/gen/terminal_interface-curses-forms.ads.m4
Normal 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;
|
@ -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;
|
@ -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
604
Ada95/gen/terminal_interface-curses-menus.ads.m4
Normal 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
182
Ada95/gen/terminal_interface-curses-mouse.ads.m4
Normal 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
70
Ada95/gen/terminal_interface-curses-panels-user_data.ads.m4
Normal 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
147
Ada95/gen/terminal_interface-curses-panels.ads.m4
Normal 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
78
Ada95/gen/terminal_interface-curses-trace.ads.m4
Normal 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
2502
Ada95/gen/terminal_interface-curses.adb.m4
Normal file
File diff suppressed because it is too large
Load Diff
1559
Ada95/gen/terminal_interface-curses.ads.m4
Normal file
1559
Ada95/gen/terminal_interface-curses.ads.m4
Normal file
File diff suppressed because it is too large
Load Diff
80
Ada95/include/MKncurses_def.sh
Executable file
80
Ada95/include/MKncurses_def.sh
Executable 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
90
Ada95/include/Makefile.in
Normal 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
72
Ada95/include/ncurses_cfg.hin
Normal 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
207
Ada95/include/ncurses_defs
Normal 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
90
Ada95/make-tar.sh
Executable 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
90
Ada95/mk-1st.awk
Normal 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
133
Ada95/samples/Makefile.in
Normal 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
35
Ada95/samples/README
Normal 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
186
Ada95/samples/explain.txt
Normal 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
47
Ada95/samples/ncurses.adb
Normal 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
714
Ada95/samples/ncurses2-acs_and_scroll.adb
Normal 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
41
Ada95/samples/ncurses2-acs_and_scroll.ads
Normal 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
235
Ada95/samples/ncurses2-acs_display.adb
Normal 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
41
Ada95/samples/ncurses2-acs_display.ads
Normal 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
362
Ada95/samples/ncurses2-attr_test.adb
Normal 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
42
Ada95/samples/ncurses2-attr_test.ads
Normal 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
259
Ada95/samples/ncurses2-color_edit.adb
Normal 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
41
Ada95/samples/ncurses2-color_edit.ads
Normal 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
163
Ada95/samples/ncurses2-color_test.adb
Normal 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
41
Ada95/samples/ncurses2-color_test.ads
Normal 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
497
Ada95/samples/ncurses2-demo_forms.adb
Normal 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
41
Ada95/samples/ncurses2-demo_forms.ads
Normal 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
675
Ada95/samples/ncurses2-demo_pad.adb
Normal 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
41
Ada95/samples/ncurses2-demo_pad.ads
Normal 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
382
Ada95/samples/ncurses2-demo_panels.adb
Normal 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
41
Ada95/samples/ncurses2-demo_panels.ads
Normal 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
135
Ada95/samples/ncurses2-flushinp_test.adb
Normal 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
43
Ada95/samples/ncurses2-flushinp_test.ads
Normal 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
117
Ada95/samples/ncurses2-genericputs.adb
Normal 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
72
Ada95/samples/ncurses2-genericputs.ads
Normal 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
41
Ada95/samples/ncurses2-getch.ads
Normal 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
254
Ada95/samples/ncurses2-getch_test.adb
Normal 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
41
Ada95/samples/ncurses2-getch_test.ads
Normal 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
163
Ada95/samples/ncurses2-getopt.adb
Normal 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
60
Ada95/samples/ncurses2-getopt.ads
Normal 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
448
Ada95/samples/ncurses2-m.adb
Normal 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
43
Ada95/samples/ncurses2-m.ads
Normal 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
168
Ada95/samples/ncurses2-menu_test.adb
Normal 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
41
Ada95/samples/ncurses2-menu_test.ads
Normal 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
157
Ada95/samples/ncurses2-overlap_test.adb
Normal 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
41
Ada95/samples/ncurses2-overlap_test.ads
Normal 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
174
Ada95/samples/ncurses2-slk_test.adb
Normal 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
41
Ada95/samples/ncurses2-slk_test.ads
Normal 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
185
Ada95/samples/ncurses2-test_sgr_attributes.adb
Normal 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
41
Ada95/samples/ncurses2-test_sgr_attributes.ads
Normal 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
480
Ada95/samples/ncurses2-trace_set.adb
Normal 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
41
Ada95/samples/ncurses2-trace_set.ads
Normal 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
190
Ada95/samples/ncurses2-util.adb
Normal 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
76
Ada95/samples/ncurses2-util.ads
Normal 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
44
Ada95/samples/ncurses2.ads
Normal 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
179
Ada95/samples/rain.adb
Normal 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
43
Ada95/samples/rain.ads
Normal 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
122
Ada95/samples/sample-curses_demo-attributes.adb
Normal 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
45
Ada95/samples/sample-curses_demo-attributes.ads
Normal 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
220
Ada95/samples/sample-curses_demo-mouse.adb
Normal 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
45
Ada95/samples/sample-curses_demo-mouse.ads
Normal 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
143
Ada95/samples/sample-curses_demo.adb
Normal 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
45
Ada95/samples/sample-curses_demo.ads
Normal 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
408
Ada95/samples/sample-explanation.adb
Normal 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
59
Ada95/samples/sample-explanation.ads
Normal 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
263
Ada95/samples/sample-form_demo-aux.adb
Normal 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
92
Ada95/samples/sample-form_demo-aux.ads
Normal 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
98
Ada95/samples/sample-form_demo-handler.adb
Normal 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
64
Ada95/samples/sample-form_demo-handler.ads
Normal 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
130
Ada95/samples/sample-form_demo.adb
Normal 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
45
Ada95/samples/sample-form_demo.ads
Normal 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
214
Ada95/samples/sample-function_key_setting.adb
Normal 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
82
Ada95/samples/sample-function_key_setting.ads
Normal 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
180
Ada95/samples/sample-header_handler.adb
Normal 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
53
Ada95/samples/sample-header_handler.ads
Normal 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
68
Ada95/samples/sample-helpers.adb
Normal 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
54
Ada95/samples/sample-helpers.ads
Normal 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
194
Ada95/samples/sample-keyboard_handler.adb
Normal 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
Loading…
Reference in New Issue
Block a user