darlinghq/darling-ncurses
1
0
Fork 0
mirror of https://github.com/darlinghq/darling-ncurses.git synced 2024-11-23 04:30:08 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Update Source To ncurses-57

Browse Source
This commit is contained in:
Thomas A 2023-02-12 08:29:39 -08:00
parent dd1f489689
commit 4d3ca81dc7
3047 changed files with 98158 additions and 16662 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
ncurses.plist Normal file
View File

@ -0,0 +1,26 @@
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
<plist version="1.0">
<dict>
<key>OpenSourceProject</key>
<string>ncurses</string>
<key>OpenSourceVersion</key>
<string>5.5</string>
<key>OpenSourceWebsiteURL</key>
<string></string>
<key>OpenSourceURL</key>
<string>ftp://invisible-island.net/ncurses/ncurses-5.7.tar.gz</string>
<key>OpenSourceSHA1</key>
<string>8233ee56ed84ae05421e4e6d6db6c1fe72ee6797</string>
<key>OpenSourceImportDate</key>
<string>2008-12-15</string>
<key>OpenSourceModifications</key>
<array>
<string></string>
</array>
<key>OpenSourceLicense</key>
<string>MIT</string>
<key>OpenSourceLicenseFile</key>
<string>ncurses.txt</string>
</dict>
</plist>

27
ncurses.txt Normal file
View File

@ -0,0 +1,27 @@
##############################################################################
# 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. #
##############################################################################

4428
ncurses.xcodeproj/project.pbxproj Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
ncurses/.DS_Store vendored Normal file
View File

Binary file not shown.

67
ncurses/Ada95/Makefile.in Normal file
View File

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

33
ncurses/Ada95/README Normal file
View File

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

55
ncurses/Ada95/TODO Normal file
View File

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

474
ncurses/Ada95/gen/Makefile.in Normal file
View File

@ -0,0 +1,474 @@
##############################################################################
# Copyright (c) 1998-2007,2008 Free Software Foundation, Inc. #
# #
# Permission is hereby granted, free of charge, to any person obtaining a #
# copy of this software and associated documentation files (the "Software"), #
# to deal in the Software without restriction, including without limitation #
# the rights to use, copy, modify, merge, publish, distribute, distribute #
# with modifications, sublicense, and/or sell copies of the Software, and to #
# permit persons to whom the Software is furnished to do so, subject to the #
# following conditions: #
# #
# The above copyright notice and this permission notice shall be included in #
# all copies or substantial portions of the Software. #
# #
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR #
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, #
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL #
# THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER #
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING #
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER #
# DEALINGS IN THE SOFTWARE. #
# #
# Except as contained in this notice, the name(s) of the above copyright #
# holders shall not be used in advertising or otherwise to promote the sale, #
# use or other dealings in this Software without prior written #
# authorization. #
##############################################################################
#
# Author: Juergen Pfeifer, 1996
#
# $Id: Makefile.in,v 1.61 2008/10/04 22:58:31 tom Exp $
#
.SUFFIXES:
SHELL = /bin/sh
THIS = Makefile
x = @PROG_EXT@
top_srcdir = @top_srcdir@
DESTDIR = @DESTDIR@
srcdir = @srcdir@
prefix = @prefix@
exec_prefix = @exec_prefix@
bindir = @bindir@
ADA_INCLUDE = $(DESTDIR)@ADA_INCLUDE@
ADA_OBJECTS = $(DESTDIR)@ADA_OBJECTS@
INSTALL = @INSTALL@
INSTALL_PROG = @INSTALL_PROGRAM@
INSTALL_DATA = @INSTALL_DATA@
AWK = @AWK@
LN_S = @LN_S@
CC = @CC@
HOST_CC = @BUILD_CC@
CFLAGS = @CFLAGS@
CPPFLAGS = @ACPPFLAGS@ \
-DHAVE_CONFIG_H -I$(srcdir)
CCFLAGS = $(CPPFLAGS) $(CFLAGS)
CFLAGS_NORMAL = $(CCFLAGS)
CFLAGS_DEBUG = $(CCFLAGS) @CC_G_OPT@ -DTRACE
CFLAGS_PROFILE = $(CCFLAGS) -pg
CFLAGS_SHARED = $(CCFLAGS) @CC_SHARED_OPTS@
CFLAGS_DEFAULT = $(CFLAGS_@DFT_UPR_MODEL@)
REL_VERSION = @cf_cv_rel_version@
ABI_VERSION = @cf_cv_abi_version@
LOCAL_LIBDIR = @top_builddir@/lib
LINK = $(HOST_CC)
LD_FLAGS = @LD_MODEL@ $(LOCAL_LIBS) @LDFLAGS@ @LIBS@ @LOCAL_LDFLAGS2@ $(LDFLAGS) @TINFO_ARGS2@
RANLIB = @RANLIB@
M4 = m4
M4FLAGS = -DNCURSES_EXT_FUNCS=@NCURSES_EXT_FUNCS@
ADACURSES_CONFIG = adacurses-config
WRAPPER = sh $(top_srcdir)/misc/shlib
GENERATE = ./gen$x '@DFT_ARG_SUFFIX@'
DEL_ADAMODE = sed -e '/^\-\-\ \ \-\*\-\ ada\ \-\*\-.*/d'
GNATHTML = `type -p gnathtml || type -p gnathtml.pl`
GNATHP = www.gnat.com
################################################################################
ALIB = @cf_ada_package@
ABASE = $(ALIB)-curses
ADA_SRCDIR = ../src
GEN_FILES0 = Base_Defs
GEN_FILES1 = ACS_Map \
AC_Rep \
Base_Defs \
Character_Attribute_Set_Rep \
Color_Defs \
Key_Definitions \
Linker_Options \
Old_Keys \
Public_Variables \
Trace_Defs \
Version_Info \
Window_Offsets
GEN_FILES2 = Menu_Opt_Rep \
Menu_Base_Defs \
Menu_Linker_Options \
Item_Rep
GEN_FILES3 = Form_Opt_Rep \
Form_Base_Defs \
Form_Linker_Options \
Field_Rep
GEN_FILES4 = Mouse_Base_Defs \
Mouse_Event_Rep \
Mouse_Events \
Panel_Linker_Options
GEN_FILES5 = Chtype_Def \
Eti_Defs
GEN_TARGETS = $(ADA_SRCDIR)/$(ABASE).ads \
$(ADA_SRCDIR)/$(ABASE).adb \
$(ADA_SRCDIR)/$(ABASE)-aux.ads \
$(ADA_SRCDIR)/$(ABASE)-trace.ads \
$(ADA_SRCDIR)/$(ABASE)-menus.ads \
$(ADA_SRCDIR)/$(ABASE)-forms.ads \
$(ADA_SRCDIR)/$(ABASE)-mouse.ads \
$(ADA_SRCDIR)/$(ABASE)-panels.ads \
$(ADA_SRCDIR)/$(ABASE)-menus-menu_user_data.ads \
$(ADA_SRCDIR)/$(ABASE)-menus-item_user_data.ads \
$(ADA_SRCDIR)/$(ABASE)-forms-form_user_data.ads \
$(ADA_SRCDIR)/$(ABASE)-forms-field_types.ads \
$(ADA_SRCDIR)/$(ABASE)-forms-field_user_data.ads \
$(ADA_SRCDIR)/$(ABASE)-panels-user_data.ads
GEN_SRC = $(srcdir)/$(ABASE).ads.m4 \
$(srcdir)/$(ABASE).adb.m4 \
$(srcdir)/$(ABASE)-aux.ads.m4 \
$(srcdir)/$(ABASE)-trace.ads.m4 \
$(srcdir)/$(ABASE)-menus.ads.m4 \
$(srcdir)/$(ABASE)-forms.ads.m4 \
$(srcdir)/$(ABASE)-mouse.ads.m4 \
$(srcdir)/$(ABASE)-panels.ads.m4 \
$(srcdir)/$(ABASE)-menus-menu_user_data.ads.m4 \
$(srcdir)/$(ABASE)-menus-item_user_data.ads.m4 \
$(srcdir)/$(ABASE)-forms-form_user_data.ads.m4 \
$(srcdir)/$(ABASE)-forms-field_types.ads.m4 \
$(srcdir)/$(ABASE)-forms-field_user_data.ads.m4 \
$(srcdir)/$(ABASE)-panels-user_data.ads.m4
all \
libs : $(GEN_TARGETS)
@echo made $@
sources:
$(ADA_INCLUDE) \
$(ADA_OBJECTS) :
sh $(top_srcdir)/mkdirs.sh $@
install \
install.libs :: $(ADA_INCLUDE)
@echo installing package $(ALIB) in $(ADA_INCLUDE)
@$(top_srcdir)/tar-copy.sh '$(ALIB)*.ad?' $(ADA_SRCDIR) $(ADA_INCLUDE)
@$(top_srcdir)/tar-copy.sh '$(ALIB)[-.]*.ad?' $(ADA_SRCDIR) $(ADA_INCLUDE)
@test $(srcdir) != ./ && $(top_srcdir)/tar-copy.sh '$(ALIB)*.ad?' $(srcdir)/../src $(ADA_INCLUDE)
@test $(srcdir) != ./ && $(top_srcdir)/tar-copy.sh '$(ALIB)[-.]*.ad?' $(srcdir)/../src $(ADA_INCLUDE)
install \
install.libs :: $(ADA_OBJECTS)
@echo installing package $(ALIB) in $(ADA_OBJECTS)
@-chmod a-wx $(ADA_SRCDIR)/*.ali
@$(top_srcdir)/tar-copy.sh '$(ALIB)*.ali' $(ADA_SRCDIR) $(ADA_OBJECTS)
@$(top_srcdir)/tar-copy.sh '$(ALIB)[-.]*.ali' $(ADA_SRCDIR) $(ADA_OBJECTS)
@-chmod u+x $(ADA_SRCDIR)/*.ali
install \
install.libs :: $(DESTDIR)$(bindir) adacurses-config
$(INSTALL_PROG) adacurses-config $(DESTDIR)$(bindir)/$(ADACURSES_CONFIG)
uninstall \
uninstall.libs ::
@echo removing package $(ALIB) from $(ADA_INCLUDE)
-@cd $(ADA_INCLUDE) && rm -f $(ALIB)[-.]*
uninstall \
uninstall.libs ::
@echo removing package $(ALIB) from $(ADA_OBJECTS)
-@cd $(ADA_OBJECTS) && rm -f $(ALIB)[-.]*
uninstall \
uninstall.libs ::
-rm -f $(DESTDIR)$(bindir)/$(ADACURSES_CONFIG)
gen$x: gen.o
@ECHO_LINK@ $(LINK) $(CFLAGS_NORMAL) gen.o $(LD_FLAGS) -o $@
gen.o: $(srcdir)/gen.c
$(HOST_CC) $(CFLAGS_NORMAL) -c -o $@ $(srcdir)/gen.c
################################################################################
Character_Attribute_Set_Rep: gen$x
$(WRAPPER) "$(GENERATE) B A" >$@
Base_Defs: gen$x
$(WRAPPER) "$(GENERATE) B B" >$@
Color_Defs: gen$x
$(WRAPPER) "$(GENERATE) B C" >$@
Window_Offsets: gen$x
$(WRAPPER) "$(GENERATE) B D" >$@
Key_Definitions: gen$x
$(WRAPPER) "$(GENERATE) B K" >$@
Linker_Options: gen$x
$(WRAPPER) "$(GENERATE) B L" >$@
ACS_Map: gen$x
$(WRAPPER) "$(GENERATE) B M" >$@
Old_Keys: gen$x
$(WRAPPER) "$(GENERATE) B O" >$@
Public_Variables: gen$x
$(WRAPPER) "$(GENERATE) B P" >$@
AC_Rep: gen$x
$(WRAPPER) "$(GENERATE) B R" >$@
Version_Info: gen$x
$(WRAPPER) "$(GENERATE) B V" >$@
Trace_Defs: gen$x
$(WRAPPER) "$(GENERATE) B T" >$@
################################################################################
Menu_Opt_Rep: gen$x
$(WRAPPER) "$(GENERATE) M R" >$@
Menu_Base_Defs: gen$x
$(WRAPPER) "$(GENERATE) M B" >$@
Menu_Linker_Options: gen$x
$(WRAPPER) "$(GENERATE) M L" >$@
Item_Rep: gen$x
$(WRAPPER) "$(GENERATE) M I" >$@
################################################################################
Form_Opt_Rep: gen$x
$(WRAPPER) "$(GENERATE) F R" >$@
Form_Base_Defs: gen$x
$(WRAPPER) "$(GENERATE) F B" >$@
Form_Linker_Options: gen$x
$(WRAPPER) "$(GENERATE) F L" >$@
Field_Rep: gen$x
$(WRAPPER) "$(GENERATE) F I" >$@
################################################################################
Mouse_Base_Defs: gen$x
$(WRAPPER) "$(GENERATE) P B" >$@
Mouse_Event_Rep: gen$x
$(WRAPPER) "$(GENERATE) P M" >$@
Mouse_Events: gen$x
$(WRAPPER) "$(GENERATE) B E" >$@
Panel_Linker_Options: gen$x
$(WRAPPER) "$(GENERATE) P L" >$@
Chtype_Def: gen$x
$(WRAPPER) "$(GENERATE) E C" >$@
Eti_Defs: gen$x
$(WRAPPER) "$(GENERATE) E E" >$@
################################################################################
$(ADA_SRCDIR)/$(ABASE).ads: $(srcdir)/$(ABASE).ads.m4 \
$(GEN_FILES1) $(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE).ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE).adb: $(srcdir)/$(ABASE).adb.m4 \
$(GEN_FILES1) $(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE).adb.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-aux.ads: $(srcdir)/$(ABASE)-aux.ads.m4 \
$(GEN_FILES5) $(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-aux.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-trace.ads: $(srcdir)/$(ABASE)-trace.ads.m4 \
$(GEN_FILES5) $(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-trace.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-menus.ads: $(srcdir)/$(ABASE)-menus.ads.m4 \
$(GEN_FILES2) $(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-menus.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-forms.ads: $(srcdir)/$(ABASE)-forms.ads.m4 \
$(GEN_FILES3) $(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-forms.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-mouse.ads: $(srcdir)/$(ABASE)-mouse.ads.m4 \
$(GEN_FILES4) $(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-mouse.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-panels.ads: $(srcdir)/$(ABASE)-panels.ads.m4 \
$(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-panels.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-menus-menu_user_data.ads: \
$(srcdir)/$(ABASE)-menus-menu_user_data.ads.m4 \
$(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-menus-menu_user_data.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-menus-item_user_data.ads: \
$(srcdir)/$(ABASE)-menus-item_user_data.ads.m4 \
$(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-menus-item_user_data.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-forms-form_user_data.ads: \
$(srcdir)/$(ABASE)-forms-form_user_data.ads.m4 \
$(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-forms-form_user_data.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-forms-field_types.ads: \
$(srcdir)/$(ABASE)-forms-field_types.ads.m4 \
$(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-forms-field_types.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-forms-field_user_data.ads: \
$(srcdir)/$(ABASE)-forms-field_user_data.ads.m4 \
$(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-forms-field_user_data.ads.m4 |\
$(DEL_ADAMODE) >$@
$(ADA_SRCDIR)/$(ABASE)-panels-user_data.ads: \
$(srcdir)/$(ABASE)-panels-user_data.ads.m4 \
$(srcdir)/normal.m4
$(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \
$(srcdir)/$(ABASE)-panels-user_data.ads.m4 |\
$(DEL_ADAMODE) >$@
install.progs ::
tags:
ctags *.[ch]
@MAKE_UPPER_TAGS@TAGS:
@MAKE_UPPER_TAGS@ etags *.[ch]
mostlyclean ::
-rm -f a.out core gen$x *.o
-rm -f $(GEN_FILES1)
-rm -f $(GEN_FILES2)
-rm -f $(GEN_FILES3)
-rm -f $(GEN_FILES4)
-rm -f $(GEN_FILES5)
clean :: mostlyclean
-rm -f $(GEN_TARGETS) instab.tmp *.ad[bs] *.html *.ali *.tmp
distclean :: clean
-rm -f adacurses-config
-rm -f Makefile
realclean :: distclean
HTML_DIR = ../../doc/html/ada
instab.tmp : table.m4 $(GEN_SRC)
@rm -f $@
@for f in $(GEN_SRC) ; do \
$(M4) $(M4FLAGS) -DM4MACRO=table.m4 $$f | $(DEL_ADAMODE) >> $@ ;\
done;
$(HTML_DIR)/table.html : instab.tmp
@-touch $@
@-chmod +w $@
@echo '<!DOCTYPE HTML' > $@
@echo 'PUBLIC "-//IETF//DTD HTML 3.0//EN">' >> $@
@echo '<HTML>' >> $@
@echo '<HEAD>' >> $@
@echo '<TITLE>Correspondence between ncurses C and Ada functions</TITLE>' >>$@
@echo '</HEAD>' >> $@
@echo '<BODY>' >> $@
@echo '<H1>Correspondence between ncurses C and Ada functions</H1>' >>$@
@echo '<H2>Sorted by C function name</H2>' >>$@
@echo '<TABLE ALIGN=CENTER BORDER>' >>$@
@echo '<TR ALIGN=LEFT>' >>$@
@echo '<TH>C name</TH><TH>Ada name</TH><TH>man page</TH></TR>' >>$@
@sort < instab.tmp >> $@
@echo '</TABLE></BODY></HTML>' >>$@
@rm -f instab.tmp
adahtml:
@find $(HTML_DIR) -type f -exec rm -f {} \;
@mkdir -p $(HTML_DIR)
cp -p ../src/*.ad[sb] . && chmod +w *.ad[sb]
ln -sf ../src/*.ali .
@echo "Filtering generated files"
@for f in $(GEN_SRC); do \
h=`basename $$f` ;\
g=`basename $$f .ads.m4` ;\
if test "$$g" != "$$h" ; then \
$(M4) $(M4FLAGS) -DM4MACRO=html.m4 $$f | $(DEL_ADAMODE) > $$g.ads ;\
echo "... $$g.ads" ;\
fi \
done
@-rm -f $(HTML_DIR)/$(ALIB)*.htm*
$(GNATHTML) -d -f $(ALIB)*.ads
for f in html/$(ALIB)*.htm*; do \
a=`basename $$f` ; \
sed -e 's/You may also.*body.*//' <$$f |\
sed -e 's%GNAT%<A HREF="http://$(GNATHP)">GNAT</A>%g' |\
sed -e 's%&lt;A HREF%<A HREF%g' |\
sed -e 's%"&gt;%">%g' |\
sed -e 's/3X/3x/g' |\
sed -e 's/$$\([ABCDEFGHIJKLMNOPQRSTUVWXZabcdefghijklmnopqrstuvwxz0123456789_]*:.*\)\$$/@\1@/' |\
sed -e 's%&lt;/A&gt;%</A>%g' > $$a.tmp ;\
mv $$a.tmp $$f ;\
done
@rm -f *.ad[sb] *.ali *.tmp
@for f in funcs.htm main.htm ; do \
sed -e "\%<A HREF=funcs/ .htm>\[ \]</A>%d" < html/$$f > $$f ;\
mv $$f html/$$f ;\
done
@rm -f "html/funcs/ .htm"
@cp -pdrf html/* $(HTML_DIR)/
@rm -rf html
html : adahtml $(HTML_DIR)/table.html
@echo made $@
###############################################################################
# The remainder of this file is automatically generated during configuration
###############################################################################

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

@ -0,0 +1,35 @@
#! /bin/sh
# $Id: adacurses-config.in,v 1.2 2007/04/07 21:06:50 tom Exp $
#
# This script will return the option to add to `gnatmake' for using
# AdaCurses.
#
prefix="@prefix@"
exec_prefix="@exec_prefix@"
libdir="@libdir@"
VERSION="@NCURSES_MAJOR@.@NCURSES_MINOR@.@NCURSES_PATCH@"
CFLAGS="-I$libdir/adacurses -L$libdir/adacurses"
LIBS="-L$prefix/lib -lAdaCurses"
case "x$1" in
x--version)
echo AdaCurses $VERSION
;;
x--cflags)
echo $CFLAGS
;;
x--libs)
echo $LIBS
;;
x)
# if no parameter is given, give what gnatmake needs
echo $CFLAGS -largs $LIBS
;;
*)
echo 'Usage: adacurses-config [--version | --cflags | --libs]' >&2
exit 1
;;
esac

1523
ncurses/Ada95/gen/gen.c Normal file
View File

File diff suppressed because it is too large Load Diff

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

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

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

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

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

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

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

@ -0,0 +1,105 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-aux__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Aux --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
-- $Revision: 1.16 $
-- Binding Version 01.00
------------------------------------------------------------------------------
include(`Base_Defs')
with System;
with Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;
with Unchecked_Conversion;
package Terminal_Interface.Curses.Aux is
pragma Preelaborate (Terminal_Interface.Curses.Aux);
use type Interfaces.C.int;
subtype C_Int is Interfaces.C.int;
subtype C_Short is Interfaces.C.short;
subtype C_Long_Int is Interfaces.C.long;
subtype C_Size_T is Interfaces.C.size_t;
subtype C_UInt is Interfaces.C.unsigned;
subtype C_ULong is Interfaces.C.unsigned_long;
subtype C_Char_Ptr is Interfaces.C.Strings.chars_ptr;
type C_Void_Ptr is new System.Address;
include(`Chtype_Def')
-- This is how those constants are defined in ncurses. I see them also
-- exactly like this in all ETI implementations I ever tested. So it
-- could be that this is quite general, but please check with your curses.
-- This is critical, because curses sometime mixes boolean returns with
-- returning an error status.
Curses_Ok : constant C_Int := CF_CURSES_OK;
Curses_Err : constant C_Int := CF_CURSES_ERR;
Curses_True : constant C_Int := CF_CURSES_TRUE;
Curses_False : constant C_Int := CF_CURSES_FALSE;
-- Eti_Error: type for error codes returned by the menu and form subsystem
include(`Eti_Defs')
procedure Eti_Exception (Code : Eti_Error);
-- Dispatch the error code and raise the appropriate exception
--
--
-- Some helpers
function Chtype_To_AttrChar is new
Unchecked_Conversion (Source => C_Chtype,
Target => Attributed_Character);
function AttrChar_To_Chtype is new
Unchecked_Conversion (Source => Attributed_Character,
Target => C_Chtype);
function AttrChar_To_AttrType is new
Unchecked_Conversion (Source => Attributed_Character,
Target => C_AttrType);
function AttrType_To_AttrChar is new
Unchecked_Conversion (Source => C_AttrType,
Target => Attributed_Character);
procedure Fill_String (Cp : in chars_ptr;
Str : out String);
-- Fill the Str parameter with the string denoted by the chars_ptr
-- C-Style string.
function Fill_String (Cp : chars_ptr) return String;
-- Same but as function.
end Terminal_Interface.Curses.Aux;

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

@ -0,0 +1,238 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-forms-field_user_data__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Forms.Field_Types --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
-- $Revision: 1.14 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Interfaces.C;
package Terminal_Interface.Curses.Forms.Field_Types is
pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types);
use type Interfaces.C.int;
subtype C_Int is Interfaces.C.int;
-- MANPAGE(`form_fieldtype.3x')
type Field_Type is abstract tagged null record;
-- Abstract base type for all field types. A concrete field type
-- is an extension that adds some data elements describing formats or
-- boundary values for the type and validation routines.
-- For the builtin low-level fieldtypes, the validation routines are
-- already defined by the low-level C library.
-- The builtin types like Alpha or AlphaNumeric etc. are defined in
-- child packages of this package. You may use one of them as example
-- how to create you own child packages for low-level field types that
-- you may have already written in C.
type Field_Type_Access is access all Field_Type'Class;
-- ANCHOR(`set_field_type()',`Set_Type')
procedure Set_Field_Type (Fld : in Field;
Fld_Type : in Field_Type) is abstract;
-- AKA
-- But: we hide the vararg mechanism of the C interface. You always
-- have to pass a single Field_Type parameter.
-- ---------------------------------------------------------------------
-- MANPAGE(`form_field_validation.3x')
-- ANCHOR(`field_type()',`Get_Type')
function Get_Type (Fld : in Field) return Field_Type_Access;
-- AKA
-- ALIAS(`field_arg()')
-- In Ada95 we can combine these. If you try to retrieve the field type
-- that is not defined as extension of the abstract tagged type above,
-- you will raise a Form_Exception.
-- This is not inlined
-- +----------------------------------------------------------------------
-- | Private Part.
-- | Most of this is used by the implementations of the child packages.
-- |
private
type Makearg_Function is access
function (Args : System.Address) return System.Address;
pragma Convention (C, Makearg_Function);
type Copyarg_Function is access
function (Usr : System.Address) return System.Address;
pragma Convention (C, Copyarg_Function);
type Freearg_Function is access
procedure (Usr : System.Address);
pragma Convention (C, Freearg_Function);
type Field_Check_Function is access
function (Fld : Field; Usr : System.Address) return C_Int;
pragma Convention (C, Field_Check_Function);
type Char_Check_Function is access
function (Ch : C_Int; Usr : System.Address) return C_Int;
pragma Convention (C, Char_Check_Function);
type Choice_Function is access
function (Fld : Field; Usr : System.Address) return C_Int;
pragma Convention (C, Choice_Function);
-- +----------------------------------------------------------------------
-- | This must be in sync with the FIELDTYPE structure in form.h
-- |
type Low_Level_Field_Type is
record
Status : Interfaces.C.short;
Ref_Count : Interfaces.C.long;
Left, Right : System.Address;
Makearg : Makearg_Function;
Copyarg : Copyarg_Function;
Freearg : Freearg_Function;
Fcheck : Field_Check_Function;
Ccheck : Char_Check_Function;
Next, Prev : Choice_Function;
end record;
pragma Convention (C, Low_Level_Field_Type);
type C_Field_Type is access all Low_Level_Field_Type;
Null_Field_Type : constant C_Field_Type := null;
-- +----------------------------------------------------------------------
-- | This four low-level fieldtypes are the ones associated with
-- | fieldtypes handled by this binding. Any other low-level fieldtype
-- | will result in a Form_Exception is function Get_Type.
-- |
M_Generic_Type : C_Field_Type := null;
M_Generic_Choice : C_Field_Type := null;
M_Builtin_Router : C_Field_Type := null;
M_Choice_Router : C_Field_Type := null;
-- Two wrapper functions to access those low-level fieldtypes defined
-- in this package.
function C_Builtin_Router return C_Field_Type;
function C_Choice_Router return C_Field_Type;
procedure Wrap_Builtin (Fld : Field;
Typ : Field_Type'Class;
Cft : C_Field_Type := C_Builtin_Router);
-- This procedure has to be called by the Set_Field_Type implementation
-- for builtin low-level fieldtypes to replace it by an Ada95
-- conformant Field_Type object.
-- The parameter Cft must be C_Builtin_Router for regular low-level
-- fieldtypes (like TYP_ALPHA or TYP_ALNUM) and C_Choice_Router for
-- low-level fieldtypes witch choice functions (like TYP_ENUM).
-- Any other value will raise a Form_Exception.
function Make_Arg (Args : System.Address) return System.Address;
pragma Convention (C, Make_Arg);
-- This is the Makearg_Function for the internal low-level types
-- introduced by this binding.
function Copy_Arg (Usr : System.Address) return System.Address;
pragma Convention (C, Copy_Arg);
-- This is the Copyarg_Function for the internal low-level types
-- introduced by this binding.
procedure Free_Arg (Usr : System.Address);
pragma Convention (C, Free_Arg);
-- This is the Freearg_Function for the internal low-level types
-- introduced by this binding.
function Field_Check_Router (Fld : Field;
Usr : System.Address) return C_Int;
pragma Convention (C, Field_Check_Router);
-- This is the Field_Check_Function for the internal low-level types
-- introduced to wrap the low-level types by a Field_Type derived
-- type. It routes the call to the corresponding low-level validation
-- function.
function Char_Check_Router (Ch : C_Int;
Usr : System.Address) return C_Int;
pragma Convention (C, Char_Check_Router);
-- This is the Char_Check_Function for the internal low-level types
-- introduced to wrap the low-level types by a Field_Type derived
-- type. It routes the call to the corresponding low-level validation
-- function.
function Next_Router (Fld : Field;
Usr : System.Address) return C_Int;
pragma Convention (C, Next_Router);
-- This is the Choice_Function for the internal low-level types
-- introduced to wrap the low-level types by a Field_Type derived
-- type. It routes the call to the corresponding low-level next_choice
-- function.
function Prev_Router (Fld : Field;
Usr : System.Address) return C_Int;
pragma Convention (C, Prev_Router);
-- This is the Choice_Function for the internal low-level types
-- introduced to wrap the low-level types by a Field_Type derived
-- type. It routes the call to the corresponding low-level prev_choice
-- function.
-- This is the Argument structure maintained by all low-level field types
-- introduced by this binding.
type Argument is record
Typ : Field_Type_Access; -- the Field_Type creating this record
Usr : System.Address; -- original arg for builtin low-level types
Cft : C_Field_Type; -- the original low-level type
end record;
type Argument_Access is access all Argument;
-- +----------------------------------------------------------------------
-- |
-- | Some Imports of libform routines to deal with low-level fieldtypes.
-- |
function New_Fieldtype (Fcheck : Field_Check_Function;
Ccheck : Char_Check_Function)
return C_Field_Type;
pragma Import (C, New_Fieldtype, "new_fieldtype");
function Set_Fieldtype_Arg (Cft : C_Field_Type;
Mak : Makearg_Function := Make_Arg'Access;
Cop : Copyarg_Function := Copy_Arg'Access;
Fre : Freearg_Function := Free_Arg'Access)
return C_Int;
pragma Import (C, Set_Fieldtype_Arg, "set_fieldtype_arg");
function Set_Fieldtype_Choice (Cft : C_Field_Type;
Next, Prev : Choice_Function)
return C_Int;
pragma Import (C, Set_Fieldtype_Choice, "set_fieldtype_choice");
end Terminal_Interface.Curses.Forms.Field_Types;

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

@ -0,0 +1,70 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-forms-field_user_data__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Forms.Field_User_Data --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
-- $Revision: 1.15 $
-- Binding Version 01.00
------------------------------------------------------------------------------
generic
type User is limited private;
type User_Access is access User;
package Terminal_Interface.Curses.Forms.Field_User_Data is
pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_User_Data);
-- MANPAGE(`form_field_userptr.3x')
-- ANCHOR(`set_field_userptr',`Set_User_Data')
procedure Set_User_Data (Fld : in Field;
Data : in User_Access);
-- AKA
pragma Inline (Set_User_Data);
-- ANCHOR(`field_userptr',`Get_User_Data')
procedure Get_User_Data (Fld : in Field;
Data : out User_Access);
-- AKA
-- ANCHOR(`field_userptr',`Get_User_Data')
function Get_User_Data (Fld : in Field) return User_Access;
-- AKA
-- Sama as function
pragma Inline (Get_User_Data);
end Terminal_Interface.Curses.Forms.Field_User_Data;

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

@ -0,0 +1,70 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-forms-form_user_data__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Forms.Form_User_Data --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
-- $Revision: 1.14 $
-- Binding Version 01.00
------------------------------------------------------------------------------
generic
type User is limited private;
type User_Access is access User;
package Terminal_Interface.Curses.Forms.Form_User_Data is
pragma Preelaborate (Terminal_Interface.Curses.Forms.Form_User_Data);
-- MANPAGE(`form_userptr.3x')
-- ANCHOR(`set_form_userptr',`Set_User_Data')
procedure Set_User_Data (Frm : in Form;
Data : in User_Access);
-- AKA
pragma Inline (Set_User_Data);
-- ANCHOR(`form_userptr',`Get_User_Data')
procedure Get_User_Data (Frm : in Form;
Data : out User_Access);
-- AKA
-- ANCHOR(`form_userptr',`Get_User_Data')
function Get_User_Data (Frm : in Form) return User_Access;
-- AKA
-- Same as function
pragma Inline (Get_User_Data);
end Terminal_Interface.Curses.Forms.Form_User_Data;

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

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

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

@ -0,0 +1,75 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-menus-item_user_data__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Menus.Item_User_Data --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998,2006 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
-- $Revision: 1.16 $
-- $Date: 2006/06/25 14:30:22 $
-- Binding Version 01.00
------------------------------------------------------------------------------
generic
type User is limited private;
type User_Access is access User;
package Terminal_Interface.Curses.Menus.Item_User_Data is
pragma Preelaborate (Terminal_Interface.Curses.Menus.Item_User_Data);
-- The binding uses the same user pointer for menu items
-- as the low level C implementation. So you can safely
-- read or write the user pointer also with the C routines
--
-- MANPAGE(`mitem_userptr.3x')
-- ANCHOR(`set_item_userptr',`Set_User_Data')
procedure Set_User_Data (Itm : in Item;
Data : in User_Access);
-- AKA
pragma Inline (Set_User_Data);
-- ANCHOR(`item_userptr',`Get_User_Data')
procedure Get_User_Data (Itm : in Item;
Data : out User_Access);
-- AKA
-- ANCHOR(`item_userptr',`Get_User_Data')
function Get_User_Data (Itm : in Item) return User_Access;
-- AKA
-- Same as function
pragma Inline (Get_User_Data);
end Terminal_Interface.Curses.Menus.Item_User_Data;

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

@ -0,0 +1,70 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-menus-menu_user_data__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Menus.Menu_User_Data --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
-- $Revision: 1.14 $
-- Binding Version 01.00
------------------------------------------------------------------------------
generic
type User is limited private;
type User_Access is access User;
package Terminal_Interface.Curses.Menus.Menu_User_Data is
pragma Preelaborate (Terminal_Interface.Curses.Menus.Menu_User_Data);
-- MANPAGE(`menu_userptr.3x')
-- ANCHOR(`set_menu_userptr',`Set_User_Data')
procedure Set_User_Data (Men : in Menu;
Data : in User_Access);
-- AKA
pragma Inline (Set_User_Data);
-- ANCHOR(`menu_userptr',`Get_User_Data')
procedure Get_User_Data (Men : in Menu;
Data : out User_Access);
-- AKA
-- ANCHOR(`menu_userptr',`Get_User_Data')
function Get_User_Data (Men : in Menu) return User_Access;
-- AKA
-- Same as function
pragma Inline (Get_User_Data);
end Terminal_Interface.Curses.Menus.Menu_User_Data;

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

@ -0,0 +1,604 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-menus__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Menu --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998,2006 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
-- $Revision: 1.27 $
-- $Date: 2007/05/05 20:20:52 $
-- Binding Version 01.00
------------------------------------------------------------------------------
include(`Menu_Base_Defs')
with System;
with Ada.Characters.Latin_1;
package Terminal_Interface.Curses.Menus is
pragma Preelaborate (Terminal_Interface.Curses.Menus);
include(`Menu_Linker_Options')dnl
include(`Linker_Options')
Space : Character renames Ada.Characters.Latin_1.Space;
type Item is private;
type Menu is private;
---------------------------
-- Interface constants --
---------------------------
Null_Item : constant Item;
Null_Menu : constant Menu;
subtype Menu_Request_Code is Key_Code
range (Key_Max + 1) .. (Key_Max + 17);
-- The prefix M_ stands for "Menu Request"
M_Left_Item : constant Menu_Request_Code := Key_Max + 1;
M_Right_Item : constant Menu_Request_Code := Key_Max + 2;
M_Up_Item : constant Menu_Request_Code := Key_Max + 3;
M_Down_Item : constant Menu_Request_Code := Key_Max + 4;
M_ScrollUp_Line : constant Menu_Request_Code := Key_Max + 5;
M_ScrollDown_Line : constant Menu_Request_Code := Key_Max + 6;
M_ScrollDown_Page : constant Menu_Request_Code := Key_Max + 7;
M_ScrollUp_Page : constant Menu_Request_Code := Key_Max + 8;
M_First_Item : constant Menu_Request_Code := Key_Max + 9;
M_Last_Item : constant Menu_Request_Code := Key_Max + 10;
M_Next_Item : constant Menu_Request_Code := Key_Max + 11;
M_Previous_Item : constant Menu_Request_Code := Key_Max + 12;
M_Toggle_Item : constant Menu_Request_Code := Key_Max + 13;
M_Clear_Pattern : constant Menu_Request_Code := Key_Max + 14;
M_Back_Pattern : constant Menu_Request_Code := Key_Max + 15;
M_Next_Match : constant Menu_Request_Code := Key_Max + 16;
M_Previous_Match : constant Menu_Request_Code := Key_Max + 17;
-- For those who like the old 'C' names for the request codes
REQ_LEFT_ITEM : Menu_Request_Code renames M_Left_Item;
REQ_RIGHT_ITEM : Menu_Request_Code renames M_Right_Item;
REQ_UP_ITEM : Menu_Request_Code renames M_Up_Item;
REQ_DOWN_ITEM : Menu_Request_Code renames M_Down_Item;
REQ_SCR_ULINE : Menu_Request_Code renames M_ScrollUp_Line;
REQ_SCR_DLINE : Menu_Request_Code renames M_ScrollDown_Line;
REQ_SCR_DPAGE : Menu_Request_Code renames M_ScrollDown_Page;
REQ_SCR_UPAGE : Menu_Request_Code renames M_ScrollUp_Page;
REQ_FIRST_ITEM : Menu_Request_Code renames M_First_Item;
REQ_LAST_ITEM : Menu_Request_Code renames M_Last_Item;
REQ_NEXT_ITEM : Menu_Request_Code renames M_Next_Item;
REQ_PREV_ITEM : Menu_Request_Code renames M_Previous_Item;
REQ_TOGGLE_ITEM : Menu_Request_Code renames M_Toggle_Item;
REQ_CLEAR_PATTERN : Menu_Request_Code renames M_Clear_Pattern;
REQ_BACK_PATTERN : Menu_Request_Code renames M_Back_Pattern;
REQ_NEXT_MATCH : Menu_Request_Code renames M_Next_Match;
REQ_PREV_MATCH : Menu_Request_Code renames M_Previous_Match;
procedure Request_Name (Key : in Menu_Request_Code;
Name : out String);
function Request_Name (Key : Menu_Request_Code) return String;
-- Same as function
------------------
-- Exceptions --
------------------
Menu_Exception : exception;
--
-- Menu options
--
pragma Warnings (Off);
include(`Menu_Opt_Rep')dnl
pragma Warnings (On);
function Default_Menu_Options return Menu_Option_Set;
-- Initial default options for a menu.
pragma Inline (Default_Menu_Options);
--
-- Item options
--
pragma Warnings (Off);
include(`Item_Rep')dnl
pragma Warnings (On);
function Default_Item_Options return Item_Option_Set;
-- Initial default options for an item.
pragma Inline (Default_Item_Options);
--
-- Item Array
--
type Item_Array is array (Positive range <>) of aliased Item;
pragma Convention (C, Item_Array);
type Item_Array_Access is access Item_Array;
procedure Free (IA : in out Item_Array_Access;
Free_Items : Boolean := False);
-- Release the memory for an allocated item array
-- If Free_Items is True, call Delete() for all the items in
-- the array.
-- MANPAGE(`mitem_new.3x')
-- ANCHOR(`new_item()',`Create')
function Create (Name : String;
Description : String := "") return Item;
-- AKA
-- Not inlined.
-- ANCHOR(`new_item()',`New_Item')
function New_Item (Name : String;
Description : String := "") return Item
renames Create;
-- AKA
-- ANCHOR(`free_item()',`Delete')
procedure Delete (Itm : in out Item);
-- AKA
-- Resets Itm to Null_Item
-- MANPAGE(`mitem_value.3x')
-- ANCHOR(`set_item_value()',`Set_Value')
procedure Set_Value (Itm : in Item;
Value : in Boolean := True);
-- AKA
pragma Inline (Set_Value);
-- ANCHOR(`item_value()',`Value')
function Value (Itm : Item) return Boolean;
-- AKA
pragma Inline (Value);
-- MANPAGE(`mitem_visible.3x')
-- ANCHOR(`item_visible()',`Visible')
function Visible (Itm : Item) return Boolean;
-- AKA
pragma Inline (Visible);
-- MANPAGE(`mitem_opts.3x')
-- ANCHOR(`set_item_opts()',`Set_Options')
procedure Set_Options (Itm : in Item;
Options : in Item_Option_Set);
-- AKA
-- An overloaded Set_Options is defined later. Pragma Inline appears there
-- ANCHOR(`item_opts_on()',`Switch_Options')
procedure Switch_Options (Itm : in Item;
Options : in Item_Option_Set;
On : Boolean := True);
-- AKA
-- ALIAS(`item_opts_off()')
-- An overloaded Switch_Options is defined later.
-- Pragma Inline appears there
-- ANCHOR(`item_opts()',`Get_Options')
procedure Get_Options (Itm : in Item;
Options : out Item_Option_Set);
-- AKA
-- ANCHOR(`item_opts()',`Get_Options')
function Get_Options (Itm : Item := Null_Item) return Item_Option_Set;
-- AKA
-- An overloaded Get_Options is defined later. Pragma Inline appears there
-- MANPAGE(`mitem_name.3x')
-- ANCHOR(`item_name()',`Name')
procedure Name (Itm : in Item;
Name : out String);
-- AKA
function Name (Itm : Item) return String;
-- AKA
-- Implemented as function
pragma Inline (Name);
-- ANCHOR(`item_description();',`Description')
procedure Description (Itm : in Item;
Description : out String);
-- AKA
function Description (Itm : Item) return String;
-- AKA
-- Implemented as function
pragma Inline (Description);
-- MANPAGE(`mitem_current.3x')
-- ANCHOR(`set_current_item()',`Set_Current')
procedure Set_Current (Men : in Menu;
Itm : in Item);
-- AKA
pragma Inline (Set_Current);
-- ANCHOR(`current_item()',`Current')
function Current (Men : Menu) return Item;
-- AKA
pragma Inline (Current);
-- ANCHOR(`set_top_row()',`Set_Top_Row')
procedure Set_Top_Row (Men : in Menu;
Line : in Line_Position);
-- AKA
pragma Inline (Set_Top_Row);
-- ANCHOR(`top_row()',`Top_Row')
function Top_Row (Men : Menu) return Line_Position;
-- AKA
pragma Inline (Top_Row);
-- ANCHOR(`item_index()',`Get_Index')
function Get_Index (Itm : Item) return Positive;
-- AKA
-- Please note that in this binding we start the numbering of items
-- with 1. So this is number is one more than you get from the low
-- level call.
pragma Inline (Get_Index);
-- MANPAGE(`menu_post.3x')
-- ANCHOR(`post_menu()',`Post')
procedure Post (Men : in Menu;
Post : in Boolean := True);
-- AKA
-- ALIAS(`unpost_menu()')
pragma Inline (Post);
-- MANPAGE(`menu_opts.3x')
-- ANCHOR(`set_menu_opts()',`Set_Options')
procedure Set_Options (Men : in Menu;
Options : in Menu_Option_Set);
-- AKA
pragma Inline (Set_Options);
-- ANCHOR(`menu_opts_on()',`Switch_Options')
procedure Switch_Options (Men : in Menu;
Options : in Menu_Option_Set;
On : Boolean := True);
-- AKA
-- ALIAS(`menu_opts_off()')
pragma Inline (Switch_Options);
-- ANCHOR(`menu_opts()',`Get_Options')
procedure Get_Options (Men : in Menu;
Options : out Menu_Option_Set);
-- AKA
-- ANCHOR(`menu_opts()',`Get_Options')
function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set;
-- AKA
pragma Inline (Get_Options);
-- MANPAGE(`menu_win.3x')
-- ANCHOR(`set_menu_win()',`Set_Window')
procedure Set_Window (Men : in Menu;
Win : in Window);
-- AKA
pragma Inline (Set_Window);
-- ANCHOR(`menu_win()',`Get_Window')
function Get_Window (Men : Menu) return Window;
-- AKA
pragma Inline (Get_Window);
-- ANCHOR(`set_menu_sub()',`Set_Sub_Window')
procedure Set_Sub_Window (Men : in Menu;
Win : in Window);
-- AKA
pragma Inline (Set_Sub_Window);
-- ANCHOR(`menu_sub()',`Get_Sub_Window')
function Get_Sub_Window (Men : Menu) return Window;
-- AKA
pragma Inline (Get_Sub_Window);
-- ANCHOR(`scale_menu()',`Scale')
procedure Scale (Men : in Menu;
Lines : out Line_Count;
Columns : out Column_Count);
-- AKA
pragma Inline (Scale);
-- MANPAGE(`menu_cursor.3x')
-- ANCHOR(`pos_menu_cursor()',`Position_Cursor')
procedure Position_Cursor (Men : Menu);
-- AKA
pragma Inline (Position_Cursor);
-- MANPAGE(`menu_mark.3x')
-- ANCHOR(`set_menu_mark()',`Set_Mark')
procedure Set_Mark (Men : in Menu;
Mark : in String);
-- AKA
pragma Inline (Set_Mark);
-- ANCHOR(`menu_mark()',`Mark')
procedure Mark (Men : in Menu;
Mark : out String);
-- AKA
function Mark (Men : Menu) return String;
-- AKA
-- Implemented as function
pragma Inline (Mark);
-- MANPAGE(`menu_attributes.3x')
-- ANCHOR(`set_menu_fore()',`Set_Foreground')
procedure Set_Foreground
(Men : in Menu;
Fore : in Character_Attribute_Set := Normal_Video;
Color : in Color_Pair := Color_Pair'First);
-- AKA
pragma Inline (Set_Foreground);
-- ANCHOR(`menu_fore()',`Foreground')
procedure Foreground (Men : in Menu;
Fore : out Character_Attribute_Set);
-- AKA
-- ANCHOR(`menu_fore()',`Foreground')
procedure Foreground (Men : in Menu;
Fore : out Character_Attribute_Set;
Color : out Color_Pair);
-- AKA
pragma Inline (Foreground);
-- ANCHOR(`set_menu_back()',`Set_Background')
procedure Set_Background
(Men : in Menu;
Back : in Character_Attribute_Set := Normal_Video;
Color : in Color_Pair := Color_Pair'First);
-- AKA
pragma Inline (Set_Background);
-- ANCHOR(`menu_back()',`Background')
procedure Background (Men : in Menu;
Back : out Character_Attribute_Set);
-- AKA
-- ANCHOR(`menu_back()',`Background')
procedure Background (Men : in Menu;
Back : out Character_Attribute_Set;
Color : out Color_Pair);
-- AKA
pragma Inline (Background);
-- ANCHOR(`set_menu_grey()',`Set_Grey')
procedure Set_Grey
(Men : in Menu;
Grey : in Character_Attribute_Set := Normal_Video;
Color : in Color_Pair := Color_Pair'First);
-- AKA
pragma Inline (Set_Grey);
-- ANCHOR(`menu_grey()',`Grey')
procedure Grey (Men : in Menu;
Grey : out Character_Attribute_Set);
-- AKA
-- ANCHOR(`menu_grey()',`Grey')
procedure Grey
(Men : in Menu;
Grey : out Character_Attribute_Set;
Color : out Color_Pair);
-- AKA
pragma Inline (Grey);
-- ANCHOR(`set_menu_pad()',`Set_Pad_Character')
procedure Set_Pad_Character (Men : in Menu;
Pad : in Character := Space);
-- AKA
pragma Inline (Set_Pad_Character);
-- ANCHOR(`menu_pad()',`Pad_Character')
procedure Pad_Character (Men : in Menu;
Pad : out Character);
-- AKA
pragma Inline (Pad_Character);
-- MANPAGE(`menu_spacing.3x')
-- ANCHOR(`set_menu_spacing()',`Set_Spacing')
procedure Set_Spacing (Men : in Menu;
Descr : in Column_Position := 0;
Row : in Line_Position := 0;
Col : in Column_Position := 0);
-- AKA
pragma Inline (Set_Spacing);
-- ANCHOR(`menu_spacing()',`Spacing')
procedure Spacing (Men : in Menu;
Descr : out Column_Position;
Row : out Line_Position;
Col : out Column_Position);
-- AKA
pragma Inline (Spacing);
-- MANPAGE(`menu_pattern.3x')
-- ANCHOR(`set_menu_pattern()',`Set_Pattern')
function Set_Pattern (Men : Menu;
Text : String) return Boolean;
-- AKA
-- Return TRUE if the pattern matches, FALSE otherwise
pragma Inline (Set_Pattern);
-- ANCHOR(`menu_pattern()',`Pattern')
procedure Pattern (Men : in Menu;
Text : out String);
-- AKA
pragma Inline (Pattern);
-- MANPAGE(`menu_format.3x')
-- ANCHOR(`set_menu_format()',`Set_Format')
procedure Set_Format (Men : in Menu;
Lines : in Line_Count;
Columns : in Column_Count);
-- Not implemented: 0 argument for Lines or Columns;
-- instead use Format to get the current sizes
-- The default format is 16 rows, 1 column. Calling
-- set_menu_format with a null menu pointer will change this
-- default. A zero row or column argument to set_menu_format
-- is interpreted as a request not to change the current
-- value.
-- AKA
pragma Inline (Set_Format);
-- ANCHOR(`menu_format()',`Format')
procedure Format (Men : in Menu;
Lines : out Line_Count;
Columns : out Column_Count);
-- AKA
pragma Inline (Format);
-- MANPAGE(`menu_hook.3x')
type Menu_Hook_Function is access procedure (Men : in Menu);
pragma Convention (C, Menu_Hook_Function);
-- ANCHOR(`set_item_init()',`Set_Item_Init_Hook')
procedure Set_Item_Init_Hook (Men : in Menu;
Proc : in Menu_Hook_Function);
-- AKA
pragma Inline (Set_Item_Init_Hook);
-- ANCHOR(`set_item_term()',`Set_Item_Term_Hook')
procedure Set_Item_Term_Hook (Men : in Menu;
Proc : in Menu_Hook_Function);
-- AKA
pragma Inline (Set_Item_Term_Hook);
-- ANCHOR(`set_menu_init()',`Set_Menu_Init_Hook')
procedure Set_Menu_Init_Hook (Men : in Menu;
Proc : in Menu_Hook_Function);
-- AKA
pragma Inline (Set_Menu_Init_Hook);
-- ANCHOR(`set_menu_term()',`Set_Menu_Term_Hook')
procedure Set_Menu_Term_Hook (Men : in Menu;
Proc : in Menu_Hook_Function);
-- AKA
pragma Inline (Set_Menu_Term_Hook);
-- ANCHOR(`item_init()',`Get_Item_Init_Hook')
function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function;
-- AKA
pragma Inline (Get_Item_Init_Hook);
-- ANCHOR(`item_term()',`Get_Item_Term_Hook')
function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function;
-- AKA
pragma Inline (Get_Item_Term_Hook);
-- ANCHOR(`menu_init()',`Get_Menu_Init_Hook')
function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function;
-- AKA
pragma Inline (Get_Menu_Init_Hook);
-- ANCHOR(`menu_term()',`Get_Menu_Term_Hook')
function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function;
-- AKA
pragma Inline (Get_Menu_Term_Hook);
-- MANPAGE(`menu_items.3x')
-- ANCHOR(`set_menu_items()',`Redefine')
procedure Redefine (Men : in Menu;
Items : in Item_Array_Access);
-- AKA
pragma Inline (Redefine);
procedure Set_Items (Men : in Menu;
Items : in Item_Array_Access) renames Redefine;
-- pragma Inline (Set_Items);
-- ANCHOR(`menu_items()',`Items')
function Items (Men : Menu;
Index : Positive) return Item;
-- AKA
pragma Inline (Items);
-- ANCHOR(`item_count()',`Item_Count')
function Item_Count (Men : Menu) return Natural;
-- AKA
pragma Inline (Item_Count);
-- MANPAGE(`menu_new.3x')
-- ANCHOR(`new_menu()',`Create')
function Create (Items : Item_Array_Access) return Menu;
-- AKA
-- Not inlined
function New_Menu (Items : Item_Array_Access) return Menu renames Create;
-- ANCHOR(`free_menu()',`Delete')
procedure Delete (Men : in out Menu);
-- AKA
-- Reset Men to Null_Menu
-- Not inlined
-- MANPAGE(`menu_driver.3x')
type Driver_Result is (Menu_Ok,
Request_Denied,
Unknown_Request,
No_Match);
-- ANCHOR(`menu_driver()',`Driver')
function Driver (Men : Menu;
Key : Key_Code) return Driver_Result;
-- AKA
-- Driver is not inlined
-- ANCHOR(`menu_requestname.3x')
-- Not Implemented: menu_request_name, menu_request_by_name
-------------------------------------------------------------------------------
private
type Item is new System.Storage_Elements.Integer_Address;
type Menu is new System.Storage_Elements.Integer_Address;
Null_Item : constant Item := 0;
Null_Menu : constant Menu := 0;
end Terminal_Interface.Curses.Menus;

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

@ -0,0 +1,182 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-mouse__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Mouse --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998-2004,2006 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
-- $Revision: 1.27 $
-- $Date: 2006/06/25 14:30:22 $
-- Binding Version 01.00
------------------------------------------------------------------------------
include(`Mouse_Base_Defs')
with System;
package Terminal_Interface.Curses.Mouse is
pragma Preelaborate (Terminal_Interface.Curses.Mouse);
-- MANPAGE(`curs_mouse.3x')
-- Please note, that in ncurses-1.9.9e documentation mouse support
-- is still marked as experimental. So also this binding will change
-- if the ncurses methods change.
--
-- mouse_trafo, wmouse_trafo are implemented as Transform_Coordinates
-- in the parent package.
--
-- Not implemented:
-- REPORT_MOUSE_POSITION (i.e. as a parameter to Register_Reportable_Event
-- or Start_Mouse)
type Event_Mask is private;
No_Events : constant Event_Mask;
All_Events : constant Event_Mask;
type Mouse_Button is (Left, -- aka: Button 1
Middle, -- aka: Button 2
Right, -- aka: Button 3
Button4, -- aka: Button 4
Control, -- Control Key
Shift, -- Shift Key
Alt); -- ALT Key
subtype Real_Buttons is Mouse_Button range Left .. Button4;
subtype Modifier_Keys is Mouse_Button range Control .. Alt;
type Button_State is (Released,
Pressed,
Clicked,
Double_Clicked,
Triple_Clicked);
type Button_States is array (Button_State) of Boolean;
pragma Pack (Button_States);
All_Clicks : constant Button_States := (Clicked .. Triple_Clicked => True,
others => False);
All_States : constant Button_States := (others => True);
type Mouse_Event is private;
-- MANPAGE(`curs_mouse.3x')
function Has_Mouse return Boolean;
-- Return true if a mouse device is supported, false otherwise.
procedure Register_Reportable_Event
(Button : in Mouse_Button;
State : in Button_State;
Mask : in out Event_Mask);
-- Stores the event described by the button and the state in the mask.
-- Before you call this the first time, you should init the mask
-- with the Empty_Mask constant
pragma Inline (Register_Reportable_Event);
procedure Register_Reportable_Events
(Button : in Mouse_Button;
State : in Button_States;
Mask : in out Event_Mask);
-- Register all events described by the Button and the State bitmap.
-- Before you call this the first time, you should init the mask
-- with the Empty_Mask constant
-- ANCHOR(`mousemask()',`Start_Mouse')
-- There is one difference to mousmask(): we return the value of the
-- old mask, that means the event mask value before this call.
-- Not Implemented: The library version
-- returns a Mouse_Mask that tells which events are reported.
function Start_Mouse (Mask : Event_Mask := All_Events)
return Event_Mask;
-- AKA
pragma Inline (Start_Mouse);
procedure End_Mouse (Mask : in Event_Mask := No_Events);
-- Terminates the mouse, restores the specified event mask
pragma Inline (End_Mouse);
-- ANCHOR(`getmouse()',`Get_Mouse')
function Get_Mouse return Mouse_Event;
-- AKA
pragma Inline (Get_Mouse);
procedure Get_Event (Event : in Mouse_Event;
Y : out Line_Position;
X : out Column_Position;
Button : out Mouse_Button;
State : out Button_State);
-- !!! Warning: X and Y are screen coordinates. Due to ripped of lines they
-- may not be identical to window coordinates.
-- Not Implemented: Get_Event only reports one event, the C library
-- version supports multiple events, e.g. {click-1, click-3}
pragma Inline (Get_Event);
-- ANCHOR(`ungetmouse()',`Unget_Mouse')
procedure Unget_Mouse (Event : in Mouse_Event);
-- AKA
pragma Inline (Unget_Mouse);
-- ANCHOR(`wenclose()',`Enclosed_In_Window')
function Enclosed_In_Window (Win : Window := Standard_Window;
Event : Mouse_Event) return Boolean;
-- AKA
-- But : use event instead of screen coordinates.
pragma Inline (Enclosed_In_Window);
-- ANCHOR(`mouseinterval()',`Mouse_Interval')
function Mouse_Interval (Msec : Natural := 200) return Natural;
-- AKA
pragma Inline (Mouse_Interval);
private
type Event_Mask is new Interfaces.C.unsigned_long;
type Mouse_Event is
record
Id : Integer range Integer (Interfaces.C.short'First) ..
Integer (Interfaces.C.short'Last);
X, Y, Z : Integer range Integer (Interfaces.C.int'First) ..
Integer (Interfaces.C.int'Last);
Bstate : Event_Mask;
end record;
pragma Convention (C, Mouse_Event);
include(`Mouse_Event_Rep')
Generation_Bit_Order : constant System.Bit_Order := System.M4_BIT_ORDER;
-- This constant may be different on your system.
include(`Mouse_Events')
No_Events : constant Event_Mask := 0;
All_Events : constant Event_Mask := ALL_MOUSE_EVENTS;
end Terminal_Interface.Curses.Mouse;

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

@ -0,0 +1,70 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-panels-user_data__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Panels.User_Data --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
-- $Revision: 1.14 $
-- Binding Version 01.00
------------------------------------------------------------------------------
generic
type User is limited private;
type User_Access is access all User;
package Terminal_Interface.Curses.Panels.User_Data is
pragma Preelaborate (Terminal_Interface.Curses.Panels.User_Data);
-- MANPAGE(`panel.3x')
-- ANCHOR(`set_panel_userptr',`Set_User_Data')
procedure Set_User_Data (Pan : in Panel;
Data : in User_Access);
-- AKA
pragma Inline (Set_User_Data);
-- ANCHOR(`panel_userptr',`Get_User_Data')
procedure Get_User_Data (Pan : in Panel;
Data : out User_Access);
-- AKA
-- ANCHOR(`panel_userptr',`Get_User_Data')
function Get_User_Data (Pan : in Panel) return User_Access;
-- AKA
-- Same as function
pragma Inline (Get_User_Data);
end Terminal_Interface.Curses.Panels.User_Data;

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

@ -0,0 +1,147 @@
-- -*- ada -*-
define(`HTMLNAME',`terminal_interface-curses-panels__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses.Panels --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998,2006 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
-- $Revision: 1.19 $
-- $Date: 2006/06/25 14:30:22 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with System;
package Terminal_Interface.Curses.Panels is
pragma Preelaborate (Terminal_Interface.Curses.Panels);
include(`Panel_Linker_Options')dnl
include(`Linker_Options')
type Panel is private;
---------------------------
-- Interface constants --
---------------------------
Null_Panel : constant Panel;
-------------------
-- Exceptions --
-------------------
Panel_Exception : exception;
-- MANPAGE(`panel.3x')
-- ANCHOR(`new_panel()',`Create')
function Create (Win : Window) return Panel;
-- AKA
pragma Inline (Create);
-- ANCHOR(`new_panel()',`New_Panel')
function New_Panel (Win : Window) return Panel renames Create;
-- AKA
-- pragma Inline (New_Panel);
-- ANCHOR(`bottom_panel()',`Bottom')
procedure Bottom (Pan : in Panel);
-- AKA
pragma Inline (Bottom);
-- ANCHOR(`top_panel()',`Top')
procedure Top (Pan : in Panel);
-- AKA
pragma Inline (Top);
-- ANCHOR(`show_panel()',`Show')
procedure Show (Pan : in Panel);
-- AKA
pragma Inline (Show);
-- ANCHOR(`update_panels()',`Update_Panels')
procedure Update_Panels;
-- AKA
pragma Import (C, Update_Panels, "update_panels");
-- ANCHOR(`hide_panel()',`Hide')
procedure Hide (Pan : in Panel);
-- AKA
pragma Inline (Hide);
-- ANCHOR(`panel_window()',`Get_Window')
function Get_Window (Pan : Panel) return Window;
-- AKA
pragma Inline (Get_Window);
-- ANCHOR(`panel_window()',`Panel_Window')
function Panel_Window (Pan : Panel) return Window renames Get_Window;
-- pragma Inline (Panel_Window);
-- ANCHOR(`replace_panel()',`Replace')
procedure Replace (Pan : in Panel;
Win : in Window);
-- AKA
pragma Inline (Replace);
-- ANCHOR(`move_panel()',`Move')
procedure Move (Pan : in Panel;
Line : in Line_Position;
Column : in Column_Position);
-- AKA
pragma Inline (Move);
-- ANCHOR(`panel_hidden()',`Is_Hidden')
function Is_Hidden (Pan : Panel) return Boolean;
-- AKA
pragma Inline (Is_Hidden);
-- ANCHOR(`panel_above()',`Above')
function Above (Pan : Panel) return Panel;
-- AKA
pragma Import (C, Above, "panel_above");
-- ANCHOR(`panel_below()',`Below')
function Below (Pan : Panel) return Panel;
-- AKA
pragma Import (C, Below, "panel_below");
-- ANCHOR(`del_panel()',`Delete')
procedure Delete (Pan : in out Panel);
-- AKA
pragma Inline (Delete);
private
type Panel is new System.Storage_Elements.Integer_Address;
Null_Panel : constant Panel := 0;
end Terminal_Interface.Curses.Panels;

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

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

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

File diff suppressed because it is too large Load Diff

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

File diff suppressed because it is too large Load Diff

154
ncurses/Ada95/samples/Makefile.in Normal file
View File

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

35
ncurses/Ada95/samples/README Normal file
View File

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

55
ncurses/Ada95/samples/sample-keyboard_handler.ads Normal file
View File

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

67
ncurses/Ada95/samples/sample-manifest.ads Normal file
View File

@ -0,0 +1,67 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Manifest --
-- --
-- S P E C --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.11 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
package Sample.Manifest is
QUIT : constant User_Key_Code := User_Key_Code'First;
SELECT_ITEM : constant User_Key_Code := QUIT + 1;
FKEY_HELP : constant Label_Number := 1;
HELP_CODE : constant Special_Key_Code := Key_F1;
FKEY_EXPLAIN : constant Label_Number := 2;
EXPLAIN_CODE : constant Special_Key_Code := Key_F2;
FKEY_QUIT : constant Label_Number := 3;
QUIT_CODE : constant Special_Key_Code := Key_F3;
Menu_Marker : constant String := "=> ";
Default_Colors : constant Redefinable_Color_Pair := 1;
Menu_Fore_Color : constant Redefinable_Color_Pair := 2;
Menu_Back_Color : constant Redefinable_Color_Pair := 3;
Menu_Grey_Color : constant Redefinable_Color_Pair := 4;
Form_Fore_Color : constant Redefinable_Color_Pair := 5;
Form_Back_Color : constant Redefinable_Color_Pair := 6;
Notepad_Color : constant Redefinable_Color_Pair := 7;
Help_Color : constant Redefinable_Color_Pair := 8;
Header_Color : constant Redefinable_Color_Pair := 9;
end Sample.Manifest;

204
ncurses/Ada95/samples/sample-menu_demo-aux.adb Normal file
View File

@ -0,0 +1,204 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Menu_Demo.Aux --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998,2006 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.13 $
-- $Date: 2006/06/25 14:30:22 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Sample.Manifest; use Sample.Manifest;
with Sample.Helpers; use Sample.Helpers;
with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
with Sample.Explanation; use Sample.Explanation;
package body Sample.Menu_Demo.Aux is
procedure Geometry (M : in Menu;
L : out Line_Count;
C : out Column_Count;
Y : out Line_Position;
X : out Column_Position;
Fy : out Line_Position;
Fx : out Column_Position);
procedure Geometry (M : in Menu;
L : out Line_Count; -- Lines used for menu
C : out Column_Count; -- Columns used for menu
Y : out Line_Position; -- Proposed Line for menu
X : out Column_Position; -- Proposed Column for menu
Fy : out Line_Position; -- Vertical inner frame
Fx : out Column_Position) -- Horiz. inner frame
is
Spc_Desc : Column_Position; -- spaces between description and item
begin
Set_Mark (M, Menu_Marker);
Spacing (M, Spc_Desc, Fy, Fx);
Scale (M, L, C);
Fx := Fx + Column_Position (Fy - 1); -- looks a bit nicer
L := L + 2 * Fy; -- count for frame at top and bottom
C := C + 2 * Fx; -- "
-- Calculate horizontal coordinate at the screen center
X := (Columns - C) / 2;
Y := 1; -- always startin line 1
end Geometry;
procedure Geometry (M : in Menu;
L : out Line_Count; -- Lines used for menu
C : out Column_Count; -- Columns used for menu
Y : out Line_Position; -- Proposed Line for menu
X : out Column_Position) -- Proposed Column for menu
is
Fy : Line_Position;
Fx : Column_Position;
begin
Geometry (M, L, C, Y, X, Fy, Fx);
end Geometry;
function Create (M : Menu;
Title : String;
Lin : Line_Position;
Col : Column_Position) return Panel
is
W, S : Window;
L : Line_Count;
C : Column_Count;
Y, Fy : Line_Position;
X, Fx : Column_Position;
Pan : Panel;
begin
Geometry (M, L, C, Y, X, Fy, Fx);
W := New_Window (L, C, Lin, Col);
Set_Meta_Mode (W);
Set_KeyPad_Mode (W);
if Has_Colors then
Set_Background (Win => W,
Ch => (Ch => ' ',
Color => Menu_Back_Color,
Attr => Normal_Video));
Set_Foreground (Men => M, Color => Menu_Fore_Color);
Set_Background (Men => M, Color => Menu_Back_Color);
Set_Grey (Men => M, Color => Menu_Grey_Color);
Erase (W);
end if;
S := Derived_Window (W, L - Fy, C - Fx, Fy, Fx);
Set_Meta_Mode (S);
Set_KeyPad_Mode (S);
Box (W);
Set_Window (M, W);
Set_Sub_Window (M, S);
if Title'Length > 0 then
Window_Title (W, Title);
end if;
Pan := New_Panel (W);
Post (M);
return Pan;
end Create;
procedure Destroy (M : in Menu;
P : in out Panel)
is
W, S : Window;
begin
W := Get_Window (M);
S := Get_Sub_Window (M);
Post (M, False);
Erase (W);
Delete (P);
Set_Window (M, Null_Window);
Set_Sub_Window (M, Null_Window);
Delete (S);
Delete (W);
Update_Panels;
end Destroy;
function Get_Request (M : Menu; P : Panel) return Key_Code
is
W : constant Window := Get_Window (M);
K : Real_Key_Code;
Ch : Character;
begin
Top (P);
loop
K := Get_Key (W);
if K in Special_Key_Code'Range then
case K is
when HELP_CODE => Explain_Context;
when EXPLAIN_CODE => Explain ("MENUKEYS");
when Key_Home => return REQ_FIRST_ITEM;
when QUIT_CODE => return QUIT;
when Key_Cursor_Down => return REQ_DOWN_ITEM;
when Key_Cursor_Up => return REQ_UP_ITEM;
when Key_Cursor_Left => return REQ_LEFT_ITEM;
when Key_Cursor_Right => return REQ_RIGHT_ITEM;
when Key_End => return REQ_LAST_ITEM;
when Key_Backspace => return REQ_BACK_PATTERN;
when Key_Next_Page => return REQ_SCR_DPAGE;
when Key_Previous_Page => return REQ_SCR_UPAGE;
when others => return K;
end case;
elsif K in Normal_Key_Code'Range then
Ch := Character'Val (K);
case Ch is
when CAN => return QUIT; -- CTRL-X
when SO => return REQ_NEXT_ITEM; -- CTRL-N
when DLE => return REQ_PREV_ITEM; -- CTRL-P
when NAK => return REQ_SCR_ULINE; -- CTRL-U
when EOT => return REQ_SCR_DLINE; -- CTRL-D
when ACK => return REQ_SCR_DPAGE; -- CTRL-F
when STX => return REQ_SCR_UPAGE; -- CTRL-B
when EM => return REQ_CLEAR_PATTERN; -- CTRL-Y
when BS => return REQ_BACK_PATTERN; -- CTRL-H
when SOH => return REQ_NEXT_MATCH; -- CTRL-A
when ENQ => return REQ_PREV_MATCH; -- CTRL-E
when DC4 => return REQ_TOGGLE_ITEM; -- CTRL-T
when CR | LF => return SELECT_ITEM;
when others => return K;
end case;
else
return K;
end if;
end loop;
end Get_Request;
end Sample.Menu_Demo.Aux;

71
ncurses/Ada95/samples/sample-menu_demo-aux.ads Normal file
View File

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

108
ncurses/Ada95/samples/sample-menu_demo-handler.adb Normal file
View File

@ -0,0 +1,108 @@
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Menu_Demo.Handler --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998,2004 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control
-- $Revision: 1.15 $
-- $Date: 2004/08/21 21:37:00 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Sample.Menu_Demo.Aux;
with Sample.Manifest; use Sample.Manifest;
with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
package body Sample.Menu_Demo.Handler is
package Aux renames Sample.Menu_Demo.Aux;
procedure Drive_Me (M : in Menu;
Title : in String := "")
is
L : Line_Count;
C : Column_Count;
Y : Line_Position;
X : Column_Position;
begin
Aux.Geometry (M, L, C, Y, X);
Drive_Me (M, Y, X, Title);
end Drive_Me;
procedure Drive_Me (M : in Menu;
Lin : in Line_Position;
Col : in Column_Position;
Title : in String := "")
is
Mask : Event_Mask := No_Events;
Old : Event_Mask;
Pan : Panel := Aux.Create (M, Title, Lin, Col);
V : Cursor_Visibility := Invisible;
begin
-- We are only interested in Clicks with the left button
Register_Reportable_Events (Left, All_Clicks, Mask);
Old := Start_Mouse (Mask);
Set_Cursor_Visibility (V);
loop
declare
K : Key_Code := Aux.Get_Request (M, Pan);
R : constant Driver_Result := Driver (M, K);
begin
case R is
when Menu_Ok => null;
when Unknown_Request =>
declare
I : constant Item := Current (M);
O : Item_Option_Set;
begin
if K = Key_Mouse then
K := SELECT_ITEM;
end if;
Get_Options (I, O);
if K = SELECT_ITEM and then not O.Selectable then
Beep;
else
if My_Driver (M, K, Pan) then
exit;
end if;
end if;
end;
when others => Beep;
end case;
end;
end loop;
End_Mouse (Old);
Aux.Destroy (M, Pan);
end Drive_Me;
end Sample.Menu_Demo.Handler;

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

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

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