diff options
Diffstat (limited to 'ncurses-5.3/Ada95/samples')
85 files changed, 0 insertions, 11827 deletions
diff --git a/ncurses-5.3/Ada95/samples/Makefile.in b/ncurses-5.3/Ada95/samples/Makefile.in deleted file mode 100644 index f751e89..0000000 --- a/ncurses-5.3/Ada95/samples/Makefile.in +++ /dev/null @@ -1,154 +0,0 @@ -############################################################################## -# 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 -# Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en -# -# Version Control -# $Revision$ -# -.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@) - -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 -L../../lib @TEST_ARGS@ $(LD_FLAGS) -lAdaCurses @EXTRA_LIBS@ - -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 - @ - -sources : - @ - -libs \ -install \ -install.libs :: - @ - -uninstall \ -uninstall.libs :: - @ - -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: - @ - -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 - @ - - diff --git a/ncurses-5.3/Ada95/samples/README b/ncurses-5.3/Ada95/samples/README deleted file mode 100644 index 6ea8a18..0000000 --- a/ncurses-5.3/Ada95/samples/README +++ /dev/null @@ -1,6 +0,0 @@ -The intention of the demo at this point in time is not to demonstrate all -the features of (n)curses and it's subsystems, but to give some sample -sources how to use the binding at all. - -Ideally in the future we can combine both goals. - diff --git a/ncurses-5.3/Ada95/samples/explain.txt b/ncurses-5.3/Ada95/samples/explain.txt deleted file mode 100644 index 570f617..0000000 --- a/ncurses-5.3/Ada95/samples/explain.txt +++ /dev/null @@ -1,186 +0,0 @@ -#VERSION -This is Version 00.90.00 of the demo package. -#MENUKEYS -In a menu you can use the following Keys in the whole application: - - - CTRL-X eXit the menu - - CTRL-N Go to next item - - CTRL-P Go to previous item - - CTRL-U Scroll up one line - - CTRL-D Scroll down one line - - CTRL-F Scroll down one page - - PAGE DOWN Scroll down one page - - PAGE UP Scroll back one page - - CTRL-B Scroll back one page - - CTRL-Y Clear pattern - - CTRL-H Delete last character from pattern - - Backspace Delete last character from pattern - - CTRL-A Next pattern match - - CTRL-E Previous pattern match - - CTRL-T Toggle item in a multi-selection menu - - CR or LF Select an item - - HOME Key Go to the first item - - F3 Quit the menu - - Cursor Down Down one item - - Cursor Up Up one item - - Cursor Left Left one item - - Cursor Right Right one item - - END Key Go to last item -#FORMKEYS - - CTRL-X eXit the form - - CTRL-F Go forward to the next field - - CTRL-B Go backward to the previous field - - CTRL-L Go to the field left of the current one - - CTRL-R Go to the field right of the current one - - CTRL-U Go to the field above the current one - - CTRL-D Go to the field below the current one - - - CTRL-W Go to the next word in the field - - CTRL-T Go to the previous word in the field - - - CTRL-A Go to the beginning of the field - - CTRL-E Go to the end of the field - - - CTRL-I Insert a blank character at the current position - - CTRL-O Insert a line - - CTRL-V Delete a character - - CTRL-H Delete previous character - - CTRL-Y Delete a line - - CTRL-G Delete a word - - CTRL-K Clear to end of field - - - CTRL-N Next choice in a choice field (Enumerations etc.) - - CTRL-P Previous choice in a choice field. -#HELP -#HELPKEYS -You may scroll with the Cursor Up/Down Keys. -You may leave the help with the Function Key labelled 'Quit'. -#INHELP -You are already in the help system. -You may leave the help with the Function Key labelled 'Quit'. -#MAIN -This is the main menu of the sample program for the ncurses Ada95 -binding. The main intention of the demo is not to demonstate or -test all the features of ncurses and it's subsystems, but to provide -to you some sample code how to use the binding with Ada95. - -You may select this options: - - * Look at some ncurses core functions - * Look at some features of the menu subsystem - * Look at some features of the form subsystem - * Look at the output of the Ada.Text_IO like functions - for ncurses. - -#MAINPAD -You may press at any place in this demo CTRL-C. This will give you a command -window. You can just type in the Label-String of a function key, then this -key will be simulated. This should help you to run the application even if -you run it on a terminal with no or only a few function keys. With CTRL-N -and CTRL-P you may browse through the possible values in the command window. -#MENU00 -Here we give you a selection of various menu demonstrations. -#MENU-PAD00 -This menu itself is a demo for a single valued, 1-column menu with -descriptions for the items, a marker and a padding character between -the item name and the description. -#MENU01 -This is a demo of the some of the menu layout options. One of them -is the spacing functionality. Just press the Key labelled "Flip" to -flip between the non-spaced and a spaced version of the menu. Please -note that this functionality is unique for ncurses and is not found -in the SVr4 menu implementation. - -This is a menu that sometimes doesn't fit into it's window and -therefore it becomes a scroll menu. - -You can also see here very nicely the pattern matching functionality -of menus. Type for example a 'J' and you will be positioned to the -next item after the current starting with a 'J'. Any more characters -you type in make the pattern more specific. With CTRL-A and CTRL-Z -(for more details press the Key labelled "Keys") you can browse -through all the items matching the pattern. - -You may change the format of the menu. Just press one of the keys -labelled "4x1", "4x2" or "4x3" to get a menu with that many rows -and columns. - -With the Keys "O-Row" or "O-Col" (they occupy the same label and -switch on selection) you can change the major order scheme for -the menu. If "O-Col" is visible, the menu is currently major -ordered by rows, you can switch to major column order by pressing -the key. If "O-Row" is visible, it's just the reverse situation. -This Key is not visible in "4x1" layout mode, because in this case -the functionality makes no sense. - -With the Keys "Multi" or "Singl" (they occupy the same label and -switch on selection) you can change whether or not the menu allows -multiple or only single selection. - -With the Keys "+Desc" or "-Desc" (they occupy the same label and -switch on selection) you can change whether or not the descriptions -for each item should be displayed. Please not that this key is -not visible in the "4x3" layout mode, because in this case the -menu wouldn't fit on a typicall 80x24 screen. - -With the Keys "Disab" or "Enab" (they occupy the same label and -switch on selection) you can dis- or enable the selectability of -the month with 31 days. -#MENU-PAD01 -You may press "Flip" to see the effect of ncurses unique menu-spacing. -The Keys "4x1", "4x2" and "4x3" will change the format of the menu. -Please note that this is a scrolling menu. You may also play with the -pattern matching functionality or try to change the format of the menu. -For more details press the Key labelled "Help". -#FORM00 -This is a demo of the forms package. -#FORM-PAD00 -Please note that this demo is far from being complete. It really shows -only a small part of the functionality of the forms package. Let's hope -the next version will have a richer demo (You wan't to contribute ?). -#NOTIMPL -Sorry this functionality of the demo is not implemented at the moment. -Remember this is a freeware project, so I can use only my very rare -free time to continue coding. If you would like to contribute, you -are very welcome ! -#CURSES00 -This is a menu where you can select some different demos of the ncurses -functionality. -#CURSES-PAD00 -Please note that this demo is far from being complete. It really shows -only a small part of the functionality of the curses package. Let's hope -the next version will have a richer demo (You wan't to contribute ?). -#MOUSEKEYS -In this demo you may use this keys: - - - Key labelled "Help" to get a help - - Key labelled "Keys" is what you are reading now - - Key labelled "Quit" to leave the demo - -You may click the mouse buttons at any location at the screen and look -at the protocol window ! -#MOUSE00 -A rather simple use of a mouse as demo. It's there just to test the -code and to provide the sample source. - -It might be of interest, that the output into the protocol window is -done by the (n)curses Text_IO subpackages. Especially the output of -the button and state names is done by Ads's enumeration IO, which -allows you to print the names of enumeration literals. That's really -nice. -#MOUSE-PAD00 -This is a very simple demo of the mouse features of ncurses. It's there -just to test whether or not the generated code for the binding really -works on the different architectures (seems so). -#ATTRIBDEMO -Again this is a more than simple demo and just here to give you the -sourcecode. -#ATTRIBKEYS -You may press one of the three well known standard keys of this demo. -#ATTRIB-PAD00 -Again this is a more than simple demo and just here to give you the -sourcecode. Feel free to contribute more. -#TEXTIO -#TEXTIOKEYS -#TEXTIO-PAD00 -#END diff --git a/ncurses-5.3/Ada95/samples/ncurses.adb b/ncurses-5.3/Ada95/samples/ncurses.adb deleted file mode 100644 index 4a9d20f..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses.adb +++ /dev/null @@ -1,47 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with ncurses2.m; use ncurses2.m; -with GNAT.OS_Lib; use GNAT.OS_Lib; - -procedure ncurses is -begin - OS_Exit (main); -end ncurses; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-acs_and_scroll.adb b/ncurses-5.3/Ada95/samples/ncurses2-acs_and_scroll.adb deleted file mode 100644 index 7d6d198..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-acs_and_scroll.adb +++ /dev/null @@ -1,722 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- 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 : Boolean := HaveKeyPad (curpw); - do_scroll : 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 : Line_Position := lri - uli + 1; - sj : 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 : 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 HaveScroll (current.wind) then - Scroll (current.wind, 1); - end if; - when Character'Pos ('B') mod 16#20# => -- Ctrl('B') - if current /= null and 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; - Set_Raw_Mode (SwitchOn => True); - Erase; - End_Windows; - -end ncurses2.acs_and_scroll; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-acs_and_scroll.ads b/ncurses-5.3/Ada95/samples/ncurses2-acs_and_scroll.ads deleted file mode 100644 index 45f3cdc..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-acs_and_scroll.ads +++ /dev/null @@ -1,41 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -procedure ncurses2.acs_and_scroll; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-acs_display.adb b/ncurses-5.3/Ada95/samples/ncurses2-acs_display.adb deleted file mode 100644 index 7e63b79..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-acs_display.adb +++ /dev/null @@ -1,231 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- 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 : Boolean := (first = 128); - last : 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 : Line_Position := Line_Position (4 + ((code - first) mod 16)); - col : 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 : Line_Position := Line_Position (4 + (N mod height)); - col : 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)); - - end show_acs_chars; - - c1 : Key_Code; - c : Character := 'a'; -begin - loop - case c is - when 'a' => - show_acs_chars; - when '0' | '1' | '2' | '3' => - show_upper_chars (ctoi (c) * 32 + 128); - when others => - null; - end case; - Add (Line => Lines - 3, Column => 0, - Str => "Note: ANSI terminals may not display C1 characters."); - Add (Line => Lines - 2, Column => 0, - Str => "Select: a=ACS, 0=C1, 1,2,3=GR characters, q=quit"); - Refresh; - c1 := Getchar; - c := Code_To_Char (c1); - exit when c = 'q' or c = 'x'; - end loop; - Pause; - Erase; - End_Windows; -end ncurses2.acs_display; - diff --git a/ncurses-5.3/Ada95/samples/ncurses2-acs_display.ads b/ncurses-5.3/Ada95/samples/ncurses2-acs_display.ads deleted file mode 100644 index 39d9a0d..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-acs_display.ads +++ /dev/null @@ -1,41 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -procedure ncurses2.acs_display; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-attr_test.adb b/ncurses-5.3/Ada95/samples/ncurses2-attr_test.adb deleted file mode 100644 index d062572..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-attr_test.adb +++ /dev/null @@ -1,367 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- 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 : 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 : - 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 : out Integer; fg, bg : in out Color_Number; - result : out Boolean) is - ch : Key_Code := Getchar; - nc : constant Color_Number := Color_Number (Number_Of_Colors); - curscr : Window; - pragma Import (C, curscr, "curscr"); - -- curscr is not implemented in the Ada binding - 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 (curscr); - 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 : Color_Pair := - Color_Pair (fg * Color_Number (Number_Of_Colors) + bg); - begin - -- Go though each color pair. Assume that the number of - -- Redefinable_Color_Pairs is 8*8 with predefined Colors 0..7 - if not pairs (pair) then - Init_Pair (pair, fg, bg); - pairs (pair) := True; - end if; - normal.Color := pair; - end; - end if; - Set_Background (Ch => normal); - Erase; - - Add (Line => 0, Column => 20, - Str => "Character attribute test display"); - - row := show_attr (row, n, (Stand_Out => True, others => False), - "STANDOUT", True); - row := show_attr (row, n, (Reverse_Video => True, others => False), - "REVERSE", True); - row := show_attr (row, n, (Bold_Character => True, others => False), - "BOLD", True); - row := show_attr (row, n, (Under_Line => True, others => False), - "UNDERLINE", True); - row := show_attr (row, n, (Dim_Character => True, others => False), - "DIM", True); - row := show_attr (row, n, (Blink => True, others => False), - "BLINK", True); --- row := show_attr (row, n, (Protected_Character => True, --- others => False), "PROTECT", True); - row := show_attr (row, n, (Invisible_Character => True, - others => False), "INVISIBLE", True); - row := show_attr (row, n, Normal_Video, "NORMAL", False); - - Move_Cursor (Line => row, Column => 8); - if xmc > -1 then - Add (Str => "This terminal does have the magic-cookie glitch"); - else - Add (Str => "This terminal does not have the magic-cookie glitch"); - end if; - Move_Cursor (Line => row + 1, Column => 8); - Add (Str => "Enter a digit to set gaps on each side of " & - "displayed attributes"); - Move_Cursor (Line => row + 2, Column => 8); - Add (Str => "^L = repaint"); - if Has_Colors then - declare tmp1 : String (1 .. 1); - begin - Add (Str => ". f/F/b/F toggle colors ("); - Put (tmp1, Integer (fg)); - Add (Str => tmp1); - Add (Ch => '/'); - Put (tmp1, Integer (bg)); - Add (Str => tmp1); - Add (Ch => ')'); - end; - end if; - Refresh; - end; - - declare result : Boolean; begin - attr_getc (n, fg, bg, result); - exit when not result; - end; - end loop; - - Set_Background (Ch => Blank2); - Erase; - End_Windows; -end ncurses2.attr_test; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-attr_test.ads b/ncurses-5.3/Ada95/samples/ncurses2-attr_test.ads deleted file mode 100644 index ef50564..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-attr_test.ads +++ /dev/null @@ -1,42 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -procedure ncurses2.attr_test; - diff --git a/ncurses-5.3/Ada95/samples/ncurses2-color_edit.adb b/ncurses-5.3/Ada95/samples/ncurses2-color_edit.adb deleted file mode 100644 index 567235c..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-color_edit.adb +++ /dev/null @@ -1,264 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- 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; - last_c : Key_Code; -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); - - last_c := this_c; - this_c := Getchar; - if Is_Digit (this_c) then - value := 0; - end if; - - case this_c is - when KEY_UP => - current := (current - 1) mod Color_Number (max_colors); - when KEY_DOWN => - current := (current + 1) mod Color_Number (max_colors); - when KEY_RIGHT => - field := RGB_Enum'Val ((RGB_Enum'Pos (field) + 1) mod 3); - when KEY_LEFT => - field := RGB_Enum'Val ((RGB_Enum'Pos (field) - 1) mod 3); - when - Character'Pos ('0') | - Character'Pos ('1') | - Character'Pos ('2') | - Character'Pos ('3') | - Character'Pos ('4') | - Character'Pos ('5') | - Character'Pos ('6') | - Character'Pos ('7') | - Character'Pos ('8') | - Character'Pos ('9') => - value := value * 10 + RGB_Value (ctoi (Code_To_Char (this_c))); - - when Character'Pos ('+') => - change_color (current, field, value, True); - - when Character'Pos ('-') => - change_color (current, field, -value, True); - - when Character'Pos ('=') => - change_color (current, field, value, False); - - when Character'Pos ('?') => - Erase; - P (" RGB Value Editing Help"); - P (""); - P ("You are in the RGB value editor. Use the arrow keys to " & - "select one of"); - P ("the fields in one of the RGB triples of the current colors;" & - " the one"); - P ("currently selected will be reverse-video highlighted."); - P (""); - P ("To change a field, enter the digits of the new value; they" & - " are echoed"); - P ("as entered. Finish by typing `='. The change will take" & - " effect instantly."); - P ("To increment or decrement a value, use the same procedure," & - " but finish"); - P ("with a `+' or `-'."); - P (""); - P ("To quit, do `x' or 'q'"); - - Pause; - Erase; - when Character'Pos ('q') | - Character'Pos ('x') => - null; - when others => - Beep; - end case; - Move_Cursor (Line => Lines - 2, Column => 0); - Put (tmp6, Integer (value)); - Add (Str => "Number: " & tmp6); - - Clear_To_End_Of_Line; - exit when this_c = Character'Pos ('x') or - this_c = Character'Pos ('q'); - end loop; - - Erase; - End_Windows; -end ncurses2.color_edit; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-color_edit.ads b/ncurses-5.3/Ada95/samples/ncurses2-color_edit.ads deleted file mode 100644 index 23c2b59..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-color_edit.ads +++ /dev/null @@ -1,41 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -procedure ncurses2.color_edit; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-color_test.adb b/ncurses-5.3/Ada95/samples/ncurses2-color_test.adb deleted file mode 100644 index 0b69d8d..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-color_test.adb +++ /dev/null @@ -1,164 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with ncurses2.util; use ncurses2.util; - -with Terminal_Interface.Curses; use Terminal_Interface.Curses; -with Ada.Strings.Fixed; - -procedure ncurses2.color_test is - use Int_IO; - - procedure show_color_name (y, x : Integer; color : Integer); - - color_names : constant array (0 .. 15) of String (1 .. 7) := - ( - "black", - "red", - "green", - "yellow", - "blue", - "magenta", - "cyan", - "white", - "BLACK", - "RED", - "GREEN", - "YELLOW", - "BLUE", - "MAGENTA", - "CYAN", - "WHITE" - ); - - - procedure show_color_name (y, x : Integer; color : Integer) is - tmp5 : String (1 .. 5); - begin - if Number_Of_Colors > 8 then - - Put (tmp5, color); - Add (Line => Line_Position (y), Column => Column_Position (x), - Str => tmp5); - else - Add (Line => Line_Position (y), Column => Column_Position (x), - Str => color_names (color)); - end if; - end show_color_name; - - - top, width : Integer; - hello : String (1 .. 5); - -- tmp3 : String (1 .. 3); - -- tmp2 : String (1 .. 2); - -begin - Refresh; - Add (Str => "There are "); - -- Put(tmp3, Number_Of_Colors*Number_Of_Colors); - Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors * - Number_Of_Colors), - Ada.Strings.Left)); - Add (Str => " color pairs"); - Add (Ch => newl); - - if Number_Of_Colors > 8 then - width := 4; - else - width := 8; - end if; - - if Number_Of_Colors > 8 then - hello := "Test"; - else - hello := "Hello"; - end if; - - for Bright in Boolean loop - if Number_Of_Colors > 8 then - top := 0; - else - top := Boolean'Pos (Bright) * (Number_Of_Colors + 3); - end if; - Clear_To_End_Of_Screen; - Move_Cursor (Line => Line_Position (top) + 1, Column => 0); - -- Put(tmp2, Number_Of_Colors); - Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors), - Ada.Strings.Left)); - Add (Ch => 'x'); - Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors), - Ada.Strings.Left)); - Add (Str => " matrix of foreground/background colors, bright *"); - if Bright then - Add (Str => "on"); - else - Add (Str => "off"); - end if; - Add (Ch => '*'); - - for i in 0 .. Number_Of_Colors - 1 loop - show_color_name (top + 2, (i + 1) * width, i); - end loop; - for i in 0 .. Number_Of_Colors - 1 loop - show_color_name (top + 3 + i, 0, i); - end loop; - for i in 1 .. Number_Of_Color_Pairs - 1 loop - Init_Pair (Color_Pair (i), Color_Number (i mod Number_Of_Colors), - Color_Number (i / Number_Of_Colors)); - -- attron((attr_t) COLOR_PAIR(i)) -- Huh? - Set_Color (Pair => Color_Pair (i)); - if Bright then - Switch_Character_Attribute (Attr => (Bold_Character => True, - others => False)); - end if; - Add (Line => Line_Position (top + 3 + (i / Number_Of_Colors)), - Column => Column_Position ((i mod Number_Of_Colors + 1) * - width), - Str => hello); - Set_Character_Attributes; - end loop; - if Number_Of_Colors > 8 or Bright then - Pause; - end if; - end loop; - - Erase; - End_Windows; -end ncurses2.color_test; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-color_test.ads b/ncurses-5.3/Ada95/samples/ncurses2-color_test.ads deleted file mode 100644 index 85e1e59..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-color_test.ads +++ /dev/null @@ -1,41 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -procedure ncurses2.color_test; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-demo_forms.adb b/ncurses-5.3/Ada95/samples/ncurses2-demo_forms.adb deleted file mode 100644 index 20fa1f3..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-demo_forms.adb +++ /dev/null @@ -1,496 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- 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 : 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 : 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 : 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 : Field_Array_Access := new Field_Array (1 .. 12); - secure : Field; - myform : Form; - w : Window; - c : Key_Code; - result : Driver_Result; -begin - Move_Cursor (Line => 18, Column => 0); - Add (Str => "Defined form-traversal keys: ^Q/ESC- exit form"); - Add (Ch => newl); - Add (Str => "^N -- go to next field ^P -- go to previous field"); - Add (Ch => newl); - Add (Str => "Home -- go to first field End -- go to last field"); - Add (Ch => newl); - Add (Str => "^L -- go to field to left ^R -- go to field to right"); - Add (Ch => newl); - Add (Str => "^U -- move upward to field ^D -- move downward to field"); - Add (Ch => newl); - Add (Str => "^W -- go to next word ^B -- go to previous word"); - Add (Ch => newl); - Add (Str => "^S -- go to start of field ^E -- go to end of field"); - Add (Ch => newl); - Add (Str => "^H -- delete previous char ^Y -- delete line"); - Add (Ch => newl); - Add (Str => "^G -- delete current word ^C -- clear to end of line"); - Add (Ch => newl); - Add (Str => "^K -- clear to end of field ^X -- clear field"); - Add (Ch => newl); - Add (Str => "Arrow keys move within a field as you would expect."); - - Add (Line => 4, Column => 57, Str => "Forms Entry Test"); - - Refresh; - - -- describe the form - f (1) := make_label (0, 15, "Sample Form"); - f (2) := make_label (2, 0, "Last Name"); - f (3) := make_field (3, 0, 1, 18, False); - f (4) := make_label (2, 20, "First Name"); - f (5) := make_field (3, 20, 1, 12, False); - f (6) := make_label (2, 34, "Middle Name"); - f (7) := make_field (3, 34, 1, 12, False); - f (8) := make_label (5, 0, "Comments"); - f (9) := make_field (6, 0, 4, 46, False); - f (10) := make_label (5, 20, "Password:"); - f (11) := make_field (5, 30, 1, 9, True); - secure := f (11); - f (12) := Null_Field; - - myform := New_Form (f); - - display_form (myform); - - w := Get_Window (myform); - Set_Raw_Mode (SwitchOn => True); - Set_NL_Mode (SwitchOn => True); -- lets us read ^M's - while not finished loop - c := form_virtualize (myform, w); - result := Driver (myform, c); - case result is - when Form_Ok => - Add (Line => 5, Column => 57, Str => Get_Buffer (secure, 1)); - Clear_To_End_Of_Line; - Refresh; - when Unknown_Request => - finished := my_form_driver (myform, c); - when others => - Beep; - end case; - end loop; - - erase_form (myform); - - -- TODO Free_Form(myform); - -- for (c = 0; f[c] != 0; c++) free_field(f[c]); - Set_Raw_Mode (SwitchOn => False); - Set_NL_Mode (SwitchOn => True); - -end ncurses2.demo_forms; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-demo_forms.ads b/ncurses-5.3/Ada95/samples/ncurses2-demo_forms.ads deleted file mode 100644 index 1148169..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-demo_forms.ads +++ /dev/null @@ -1,41 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -procedure ncurses2.demo_forms; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-demo_pad.adb b/ncurses-5.3/Ada95/samples/ncurses2-demo_pad.adb deleted file mode 100644 index 3e37a2a..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-demo_pad.adb +++ /dev/null @@ -1,671 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- 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 : 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))); - retval.seconds := Integer (t.tv_sec); - retval.microseconds := Integer (t.tv_usec); - 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 : 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 - tmp : Boolean; - begin - tmp := panner_legend (line); - 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 => - basey := pymax - porty; - if basey < 0 then -- basey := max(basey, 0); - basey := 0; - 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 : 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 : Line_Position := porty - top_y - 1; - lowend, highend : Line_Position; - begin - lowend := top_y + (basey * length) / pymax; - highend := top_y + ((basey + length) * length) / pymax; - - do_v_line (top_y, portx - 1, ACS_Map (ACS_Vertical_Line), - lowend); - if highend < porty then - Switch_Character_Attribute - (Attr => (Reverse_Video => True, others => False), - On => True); - do_v_line (lowend, portx - 1, Blank2, highend + 1); - Switch_Character_Attribute - (Attr => (Reverse_Video => True, others => False), - On => False); - do_v_line (highend + 1, portx - 1, - ACS_Map (ACS_Vertical_Line), porty); - end if; - end; - else - do_v_line (top_y, portx - 1, ACS_Map (ACS_Vertical_Line), porty); - end if; - - if top_y /= 0 then - Add (Line => top_y - 1, Column => portx - 1, - Ch => ACS_Map (ACS_Upper_Right_Corner)); - end if; - if top_x /= 0 then - Add (Line => porty - 1, Column => top_x - 1, - Ch => ACS_Map (ACS_Lower_Left_Corner)); - end if; - declare - begin - -- Here is another place where it is possible - -- to write to the corner of the screen. - Add (Line => porty - 1, Column => portx - 1, - Ch => ACS_Map (ACS_Lower_Right_Corner)); - exception - when Curses_Exception => null; - end; - - before := gettime; - - Refresh_Without_Update; - - declare - -- the C version allows the panel to have a zero height - -- wich raise the exception - begin - Refresh_Without_Update - ( - pad, - basey, basex, - top_y, top_x, - porty - Line_Position (greater (pxmax, portx)) - 1, - portx - Column_Position (greater (pymax, porty)) - 1); - exception - when Curses_Exception => null; - end; - - Update_Screen; - - if timing then declare - s : String (1 .. 7); - elapsed : Long_Float; - begin - after := gettime; - elapsed := (Long_Float (after.seconds - before.seconds) + - Long_Float (after.microseconds - before.microseconds) - / 1.0e6); - Move_Cursor (Line => Lines - 1, Column => Columns - 20); - floatio.Put (s, elapsed, Aft => 3, Exp => 0); - Add (Str => s); - Refresh; - end; - end if; - - c := pgetc (pad); - exit when c = Key_Exit; - - end loop; - - Allow_Scrolling (Mode => True); - - end panner; - - Gridsize : constant := 3; - Gridcount : Integer := 0; - - Pad_High : constant Line_Count := 200; - Pad_Wide : constant Column_Count := 200; - panpad : Window := New_Pad (Pad_High, Pad_Wide); -begin - if panpad = Null_Window then - Cannot ("cannot create requested pad"); - return; - end if; - - for i in 0 .. Pad_High - 1 loop - for j in 0 .. Pad_Wide - 1 loop - if i mod Gridsize = 0 and j mod Gridsize = 0 then - if i = 0 or j = 0 then - Add (panpad, '+'); - else - -- depends on ASCII? - Add (panpad, - Ch => Character'Val (Character'Pos ('A') + - Gridcount mod 26)); - Gridcount := Gridcount + 1; - end if; - elsif i mod Gridsize = 0 then - Add (panpad, '-'); - elsif j mod Gridsize = 0 then - Add (panpad, '|'); - else - declare - -- handle the write to the lower right corner error - begin - Add (panpad, ' '); - exception - when Curses_Exception => null; - end; - end if; - end loop; - end loop; - panner_legend (Lines - 4); - panner_legend (Lines - 3); - panner_legend (Lines - 2); - panner_legend (Lines - 1); - - Set_KeyPad_Mode (panpad, True); - -- Make the pad (initially) narrow enough that a trace file won't wrap. - -- We'll still be able to widen it during a test, since that's required - -- for testing boundaries. - - panner (panpad, 2, 2, Lines - 5, Columns - 15, padgetch'Access); - - Delete (panpad); - End_Windows; -- Hmm, Erase after End_Windows - Erase; -end ncurses2.demo_pad; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-demo_pad.ads b/ncurses-5.3/Ada95/samples/ncurses2-demo_pad.ads deleted file mode 100644 index 09b8b8e..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-demo_pad.ads +++ /dev/null @@ -1,41 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -procedure ncurses2.demo_pad; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-demo_panels.adb b/ncurses-5.3/Ada95/samples/ncurses2-demo_panels.adb deleted file mode 100644 index f10d9a7..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-demo_panels.adb +++ /dev/null @@ -1,379 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- 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 nap_msec = 1 then - Getchar; - else - Nap_Milli_Seconds (nap_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 : Window := Panel_Window (pan); - num : 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 - 2 loop - for x in 1 .. maxx - 2 loop - Move_Cursor (win, y, x); - Add (win, num); - end loop; - end loop; - end fill_panel; - - modstr : 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 : User_Data_Access := new User_Data'("p1"); - U2 : User_Data_Access := new User_Data'("p2"); - U3 : User_Data_Access := new User_Data'("p3"); - U4 : User_Data_Access := new User_Data'("p4"); - U5 : 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 : Window := Panel_Window (p4); - w5 : Window := Panel_Window (p5); - begin - - saywhat ("m4; press any key to continue"); - Move_Cursor (w4, Lines / 8, 1); - Add (w4, modstr (itmp)); - Move (p4, Lines / 6, Column_Position (itmp) * (Columns / 8)); - Move_Cursor (w5, Lines / 6, 1); - Add (w5, modstr (itmp)); - pflush; - wait_a_while (nap_msec); - - saywhat ("m5; press any key to continue"); - Move_Cursor (w4, Lines / 6, 1); - Add (w4, modstr (itmp)); - Move (p5, Lines / 3 - 1, (Column_Position (itmp) * 10) + 6); - Move_Cursor (w5, Lines / 8, 1); - Add (w5, modstr (itmp)); - pflush; - wait_a_while (nap_msec); - end; - end loop; - - saywhat ("m4; press any key to continue"); - Move (p4, Lines / 6, 6 * (Columns / 8)); - -- Move(p4, Lines / 6, itmp * (Columns / 8)); - pflush; - wait_a_while (nap_msec); - - saywhat ("t5; press any key to continue"); - Top (p5); - pflush; - wait_a_while (nap_msec); - - saywhat ("t2; press any key to continue"); - Top (p2); - pflush; - wait_a_while (nap_msec); - - saywhat ("t1; press any key to continue"); - Top (p1); - pflush; - wait_a_while (nap_msec); - - saywhat ("d2; press any key to continue"); - rmpanel (p2); - pflush; - wait_a_while (nap_msec); - - saywhat ("h3; press any key to continue"); - Hide (p3); - pflush; - wait_a_while (nap_msec); - - saywhat ("d1; press any key to continue"); - rmpanel (p1); - pflush; - wait_a_while (nap_msec); - - saywhat ("d4; press any key to continue"); - rmpanel (p4); - pflush; - wait_a_while (nap_msec); - - saywhat ("d5; press any key to continue"); - rmpanel (p5); - pflush; - wait_a_while (nap_msec); - if (nap_msec = 1) then - exit; - else - nap_msec := 100; - end if; - - end; - end loop; - - Erase; - End_Windows; - -end ncurses2.demo_panels; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-demo_panels.ads b/ncurses-5.3/Ada95/samples/ncurses2-demo_panels.ads deleted file mode 100644 index 55ebdbd..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-demo_panels.ads +++ /dev/null @@ -1,41 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -procedure ncurses2.demo_panels (nap_mseci : Integer); diff --git a/ncurses-5.3/Ada95/samples/ncurses2-flushinp_test.adb b/ncurses-5.3/Ada95/samples/ncurses2-flushinp_test.adb deleted file mode 100644 index 7257bec..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-flushinp_test.adb +++ /dev/null @@ -1,135 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses; use Terminal_Interface.Curses; -with ncurses2.util; use ncurses2.util; - -procedure ncurses2.flushinp_test (win : Window) is - - procedure Continue (win : Window); - - procedure Continue (win : Window) is - begin - Set_Echo_Mode (False); - Move_Cursor (win, 10, 1); - Add (win, 10, 1, " Press any key to continue"); - Refresh (win); - Getchar (win); - end Continue; - - h, by, sh : Line_Position; - w, bx, sw : Column_Position; - - subWin : Window; - -begin - Clear (win); - Get_Size (win, h, w); - Get_Window_Position (win, by, bx); - sw := w / 3; - sh := h / 3; - subWin := Sub_Window (win, sh, sw, by + h - sh - 2, bx + w - sw - 2); - - if Has_Colors then - Init_Pair (2, Cyan, Blue); - Change_Background (subWin, - Attributed_Character'(Ch => ' ', Color => 2, - Attr => Normal_Video)); - end if; - - Set_Character_Attributes (subWin, - (Bold_Character => True, others => False)); - Box (subWin); - Add (subWin, 2, 1, "This is a subwindow"); - Refresh (win); - - Set_Cbreak_Mode (True); - Add (win, 0, 1, "This is a test of the flushinp() call."); - - Add (win, 2, 1, "Type random keys for 5 seconds."); - Add (win, 3, 1, - "These should be discarded (not echoed) after the subwindow " & - "goes away."); - Refresh (win); - - for i in 0 .. 4 loop - Move_Cursor (subWin, 1, 1); - Add (subWin, Str => "Time = "); - Add (subWin, Str => Integer'Image (i)); - Refresh (subWin); - Nap_Milli_Seconds (1000); - Flush_Input; - end loop; - - Delete (subWin); - Erase (win); - Flash_Screen; - Refresh (win); - Nap_Milli_Seconds (1000); - - Add (win, 2, 1, - Str => "If you were still typing when the window timer expired,"); - Add (win, 3, 1, - "or else you typed nothing at all while it was running,"); - Add (win, 4, 1, - "test was invalid. You'll see garbage or nothing at all. "); - Add (win, 6, 1, "Press a key"); - Move_Cursor (win, 9, 10); - Refresh (win); - Set_Echo_Mode (True); - Getchar (win); - Flush_Input; - Add (win, 12, 0, - "If you see any key other than what you typed, flushinp() is broken."); - Continue (win); - - Move_Cursor (win, 9, 10); - Delete_Character (win); - Refresh (win); - Move_Cursor (win, 12, 0); - Clear_To_End_Of_Line; - Add (win, - "What you typed should now have been deleted; if not, wdelch() " & - "failed."); - Continue (win); - - Set_Cbreak_Mode (True); - -end ncurses2.flushinp_test; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-flushinp_test.ads b/ncurses-5.3/Ada95/samples/ncurses2-flushinp_test.ads deleted file mode 100644 index 87efd47..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-flushinp_test.ads +++ /dev/null @@ -1,43 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses; - -procedure ncurses2.flushinp_test (win : Terminal_Interface.Curses.Window); diff --git a/ncurses-5.3/Ada95/samples/ncurses2-genericputs.adb b/ncurses-5.3/Ada95/samples/ncurses2-genericputs.adb deleted file mode 100644 index 1921eed..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-genericputs.adb +++ /dev/null @@ -1,126 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Ada.Text_IO; use Ada.Text_IO; -with Ada.Strings.Bounded; use Ada.Strings.Bounded; - -with Terminal_Interface.Curses; use Terminal_Interface.Curses; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; - -with Interfaces.C; use Interfaces.C; -with Interfaces.C.Strings; use Interfaces.C.Strings; - - -package body ncurses2.genericPuts is - - procedure myGet (Win : in Window := Standard_Window; - Str : out BS.Bounded_String; - Len : in Integer := -1) - is - use BS; - 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; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-genericputs.ads b/ncurses-5.3/Ada95/samples/ncurses2-genericputs.ads deleted file mode 100644 index 55e7d02..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-genericputs.ads +++ /dev/null @@ -1,73 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- 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; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-getch.ads b/ncurses-5.3/Ada95/samples/ncurses2-getch.ads deleted file mode 100644 index eb3ee66..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-getch.ads +++ /dev/null @@ -1,41 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -procedure getch_test; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-getch_test.adb b/ncurses-5.3/Ada95/samples/ncurses2-getch_test.adb deleted file mode 100644 index 5ed79a9..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-getch_test.adb +++ /dev/null @@ -1,251 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- 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 : 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 : 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; - - tmp2 := Start_Mouse (No_Events); - Set_Timeout_Mode (Mode => Blocking, Amount => 0); -- amount is ignored - Set_Raw_Mode (SwitchOn => False); - Set_NL_Mode (SwitchOn => True); - Erase; - End_Windows; -end ncurses2.getch_test; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-getch_test.ads b/ncurses-5.3/Ada95/samples/ncurses2-getch_test.ads deleted file mode 100644 index 29b8ff6..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-getch_test.ads +++ /dev/null @@ -1,41 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -procedure ncurses2.getch_test; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-getopt.adb b/ncurses-5.3/Ada95/samples/ncurses2-getopt.adb deleted file mode 100644 index 306c44d..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-getopt.adb +++ /dev/null @@ -1,168 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- 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 - - opterr : Character := Character'Val (1); - optopt : Character := '?'; - initialized : Boolean := False; - - 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 : 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); - optopt := 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); - optopt := c; - if optstring (1) = ':' then - c := ':'; - else - c := '?'; - end if; - else - -- increment it again when taking next ARGV-elt as argument. - optind := optind + 1; - optargx := To_Bounded_String (argv (optind)); - optind := optind + 1; - end if; - end if; - nextchar := 0; - else -- no argument for the option - if nextchar = argv (optind)'Length then - optind := optind + 1; - nextchar := 0; - else - nextchar := nextchar + 1; - end if; - end if; - - retval := Character'Pos (c); - Optarg := new String'(To_String (optargx)); - return; - end; - end Qgetopt; - -end ncurses2.getopt; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-getopt.ads b/ncurses-5.3/Ada95/samples/ncurses2-getopt.ads deleted file mode 100644 index 64a997d..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-getopt.ads +++ /dev/null @@ -1,59 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package ncurses2.getopt is - - type stringa is access String; - - type stringfunc is access - function (n : Positive) return String; - - - procedure Qgetopt (retval : out Integer; - argc : Integer; - argv : stringfunc; - optstring : String; - optind : in out Integer; - -- ignored for ncurses, must be initialized to 0 - -- by the caller - Optarg : out stringa - -- a garbage collector would be useful here. - ); -end ncurses2.getopt; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-m.adb b/ncurses-5.3/Ada95/samples/ncurses2-m.adb deleted file mode 100644 index 5506f91..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-m.adb +++ /dev/null @@ -1,460 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- 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.color_edit; -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. - type stringa is access String; - 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 Integer (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; - return 0; -- TODO ExitProgram(EXIT_SUCCESS); - end main; - -end ncurses2.m; - - - - - - - diff --git a/ncurses-5.3/Ada95/samples/ncurses2-m.ads b/ncurses-5.3/Ada95/samples/ncurses2-m.ads deleted file mode 100644 index bf85383..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-m.ads +++ /dev/null @@ -1,43 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package ncurses2.m is - function main return Integer; -end ncurses2.m; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-menu_test.adb b/ncurses-5.3/Ada95/samples/ncurses2-menu_test.adb deleted file mode 100644 index 18b38cc..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-menu_test.adb +++ /dev/null @@ -1,165 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- 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 : 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); - - tmp := Start_Mouse (No_Events); -end ncurses2.menu_test; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-menu_test.ads b/ncurses-5.3/Ada95/samples/ncurses2-menu_test.ads deleted file mode 100644 index 86a7e10..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-menu_test.ads +++ /dev/null @@ -1,41 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -procedure ncurses2.menu_test; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-overlap_test.adb b/ncurses-5.3/Ada95/samples/ncurses2-overlap_test.adb deleted file mode 100644 index 8ffeed6..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-overlap_test.adb +++ /dev/null @@ -1,156 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with ncurses2.util; use ncurses2.util; -with Terminal_Interface.Curses; use Terminal_Interface.Curses; - --- test effects of overlapping windows - -procedure ncurses2.overlap_test is - - procedure fillwin (win : Window; ch : Character); - procedure crosswin (win : Window; ch : Character); - - procedure fillwin (win : Window; ch : Character) is - y1 : Line_Position; - x1 : Column_Position; - begin - Get_Size (win, y1, x1); - for y in 0 .. y1 - 1 loop - Move_Cursor (win, y, 0); - for x in 0 .. x1 - 1 loop - Add (win, Ch => ch); - end loop; - end loop; - exception - when Curses_Exception => null; - -- write to lower right corner - end fillwin; - - procedure crosswin (win : Window; ch : Character) is - y1 : Line_Position; - x1 : Column_Position; - begin - Get_Size (win, y1, x1); - for y in 0 .. y1 - 1 loop - for x in 0 .. x1 - 1 loop - if (((x > (x1 - 1) / 3) and (x <= (2 * (x1 - 1)) / 3)) - or (((y > (y1 - 1) / 3) and (y <= (2 * (y1 - 1)) / 3)))) then - Move_Cursor (win, y, x); - Add (win, Ch => ch); - end if; - end loop; - end loop; - end crosswin; - - -- In a 24x80 screen like some xterms are, the instructions will - -- be overwritten. - ch : Character; - win1 : Window := New_Window (9, 20, 3, 3); - win2 : Window := New_Window (9, 20, 9, 16); -begin - Set_Raw_Mode (SwitchOn => True); - Refresh; - Move_Cursor (Line => 0, Column => 0); - Add (Str => "This test shows the behavior of wnoutrefresh() with " & - "respect to"); - Add (Ch => newl); - Add (Str => "the shared region of two overlapping windows A and B. "& - "The cross"); - Add (Ch => newl); - Add (Str => "pattern in each window does not overlap the other."); - Add (Ch => newl); - - Move_Cursor (Line => 18, Column => 0); - Add (Str => "a = refresh A, then B, then doupdate. b = refresh B, " & - "then A, then doupdaute"); - Add (Ch => newl); - Add (Str => "c = fill window A with letter A. d = fill window B " & - "with letter B."); - Add (Ch => newl); - Add (Str => "e = cross pattern in window A. f = cross pattern " & - "in window B."); - Add (Ch => newl); - Add (Str => "g = clear window A. h = clear window B."); - Add (Ch => newl); - Add (Str => "i = overwrite A onto B. j = overwrite " & - "B onto A."); - Add (Ch => newl); - Add (Str => "^Q/ESC = terminate test."); - - loop - ch := Code_To_Char (Getchar); - exit when ch = CTRL ('Q') or ch = CTRL ('['); -- QUIT or ESCAPE - case ch is - when 'a' => -- refresh window A first, then B - Refresh_Without_Update (win1); - Refresh_Without_Update (win2); - Update_Screen; - when 'b' => -- refresh window B first, then A - Refresh_Without_Update (win2); - Refresh_Without_Update (win1); - Update_Screen; - when 'c' => -- fill window A so it's visible - fillwin (win1, 'A'); - when 'd' => -- fill window B so it's visible - fillwin (win2, 'B'); - when 'e' => -- cross test pattern in window A - crosswin (win1, 'A'); - when 'f' => -- cross test pattern in window B - crosswin (win2, 'B'); - when 'g' => -- clear window A - Clear (win1); - Move_Cursor (win1, 0, 0); - when 'h' => -- clear window B - Clear (win2); - Move_Cursor (win2, 0, 0); - when 'i' => -- overwrite A onto B - Overwrite (win1, win2); - when 'j' => -- overwrite B onto A - Overwrite (win2, win1); - when others => null; - end case; - end loop; - - Delete (win2); - Delete (win1); - Erase; - End_Windows; -end ncurses2.overlap_test; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-overlap_test.ads b/ncurses-5.3/Ada95/samples/ncurses2-overlap_test.ads deleted file mode 100644 index 499c98c..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-overlap_test.ads +++ /dev/null @@ -1,41 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -procedure ncurses2.overlap_test; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-slk_test.adb b/ncurses-5.3/Ada95/samples/ncurses2-slk_test.adb deleted file mode 100644 index 483ea5b..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-slk_test.adb +++ /dev/null @@ -1,171 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- 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"); - - Txt : char_array (0 .. 10); - begin - Txt (0) := Interfaces.C.char'First; - if Wgetnstr (Win, Txt, 8) = Curses_Err then - raise Curses_Exception; - end if; - Str := To_Unbounded_String (To_Ada (Txt, True)); - end myGet; - - - use Int_IO; - - use Ada.Strings.Unbounded; - - c : Key_Code; - buf : Unbounded_String; - c2 : Character; - fmt : Label_Justification := Centered; - tmp : Integer; - -begin - c := CTRL ('l'); - loop - Move_Cursor (Line => 0, Column => 0); - c2 := Code_To_Char (c); - case c2 is - when Character'Val (Character'Pos ('l') mod 16#20#) => -- CTRL('l') - Erase; - Switch_Character_Attribute (Attr => (Bold_Character => True, - others => False)); - Add (Line => 0, Column => 20, - Str => "Soft Key Exerciser"); - Switch_Character_Attribute (On => False, - Attr => (Bold_Character => True, - others => False)); - - Move_Cursor (Line => 2, Column => 0); - P ("Available commands are:"); - P (""); - P ("^L -- refresh screen"); - P ("a -- activate or restore soft keys"); - P ("d -- disable soft keys"); - P ("c -- set centered format for labels"); - P ("l -- set left-justified format for labels"); - P ("r -- set right-justified format for labels"); - P ("[12345678] -- set label; labels are numbered 1 through 8"); - P ("e -- erase stdscr (should not erase labels)"); - P ("s -- test scrolling of shortened screen"); - P ("x, q -- return to main menu"); - P (""); - P ("Note: if activating the soft keys causes your terminal to"); - P ("scroll up one line, your terminal auto-scrolls when anything"); - P ("is written to the last screen position. The ncurses code"); - P ("does not yet handle this gracefully."); - Refresh; - Restore_Soft_Label_Keys; - - when 'a' => - Restore_Soft_Label_Keys; - when 'e' => - Clear; - when 's' => - Add (Line => 20, Column => 0, - Str => "Press Q to stop the scrolling-test: "); - loop - c := Getchar; - c2 := Code_To_Char (c); - exit when c2 = 'Q'; - -- c = ERR? - -- TODO when c is not a character (arrow key) - -- the behavior is different from the C version. - Add (Ch => c2); - end loop; - when 'd' => - Clear_Soft_Label_Keys; - when 'l' => - fmt := Left; - when 'c' => - fmt := Centered; - when 'r' => - fmt := Right; - when '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' => - Add (Line => 20, Column => 0, - Str => "Please enter the label value: "); - Set_Echo_Mode (SwitchOn => True); - myGet (Str => buf); - Set_Echo_Mode (SwitchOn => False); - tmp := ctoi (c2); - Set_Soft_Label_Key (Label_Number (tmp), To_String (buf), fmt); - Refresh_Soft_Label_Keys; - Move_Cursor (Line => 20, Column => 0); - Clear_To_End_Of_Line; - when 'x' | 'q' => - exit; - -- the C version needed a goto, ha ha - -- breaks exit the case not the loop because fall-throuh - -- happens in C! - when others => - Beep; - end case; - c := Getchar; - -- TODO exit when c = EOF - end loop; - Erase; - End_Windows; -end ncurses2.slk_test; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-slk_test.ads b/ncurses-5.3/Ada95/samples/ncurses2-slk_test.ads deleted file mode 100644 index 76d099f..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-slk_test.ads +++ /dev/null @@ -1,41 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -procedure ncurses2.slk_test; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-test_sgr_attributes.adb b/ncurses-5.3/Ada95/samples/ncurses2-test_sgr_attributes.adb deleted file mode 100644 index 44c07a7..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-test_sgr_attributes.adb +++ /dev/null @@ -1,186 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses; use Terminal_Interface.Curses; -with ncurses2.util; use ncurses2.util; - - --- Graphic-rendition test (adapted from vttest) - -procedure ncurses2.test_sgr_attributes is - - procedure xAdd (l : Line_Position; c : Column_Position; s : String); - - procedure xAdd (l : Line_Position; c : Column_Position; s : String) is - begin - Add (Line => l, Column => c, Str => s); - end xAdd; - - normal, current : Attributed_Character; -begin - for pass in reverse Boolean loop - if pass then - normal := (Ch => ' ', Attr => Normal_Video, Color => 0); - else - normal := (Ch => ' ', Attr => - (Reverse_Video => True, others => False), Color => 0); - end if; - - -- Use non-default colors if possible to exercise bce a little - if Has_Colors then - Init_Pair (1, White, Blue); - normal.Color := 1; - end if; - Set_Background (Ch => normal); - Erase; - xAdd (1, 20, "Graphic rendition test pattern:"); - - xAdd (4, 1, "vanilla"); - - - current := normal; - current.Attr.Bold_Character := not current.Attr.Bold_Character; - Set_Background (Ch => current); - xAdd (4, 40, "bold"); - - current := normal; - current.Attr.Under_Line := not current.Attr.Under_Line; - Set_Background (Ch => current); - xAdd (6, 6, "underline"); - - current := normal; - current.Attr.Bold_Character := not current.Attr.Bold_Character; - current.Attr.Under_Line := not current.Attr.Under_Line; - Set_Background (Ch => current); - xAdd (6, 45, "bold underline"); - - current := normal; - current.Attr.Blink := not current.Attr.Blink; - Set_Background (Ch => current); - xAdd (8, 1, "blink"); - - current := normal; - current.Attr.Blink := not current.Attr.Blink; - current.Attr.Bold_Character := not current.Attr.Bold_Character; - Set_Background (Ch => current); - xAdd (8, 40, "bold blink"); - - current := normal; - current.Attr.Under_Line := not current.Attr.Under_Line; - current.Attr.Blink := not current.Attr.Blink; - Set_Background (Ch => current); - xAdd (10, 6, "underline blink"); - - current := normal; - current.Attr.Bold_Character := not current.Attr.Bold_Character; - current.Attr.Under_Line := not current.Attr.Under_Line; - current.Attr.Blink := not current.Attr.Blink; - Set_Background (Ch => current); - xAdd (10, 45, "bold underline blink"); - - current := normal; - current.Attr.Reverse_Video := not current.Attr.Reverse_Video; - Set_Background (Ch => current); - xAdd (12, 1, "negative"); - - current := normal; - current.Attr.Bold_Character := not current.Attr.Bold_Character; - current.Attr.Reverse_Video := not current.Attr.Reverse_Video; - Set_Background (Ch => current); - xAdd (12, 40, "bold negative"); - - current := normal; - current.Attr.Under_Line := not current.Attr.Under_Line; - current.Attr.Reverse_Video := not current.Attr.Reverse_Video; - Set_Background (Ch => current); - xAdd (14, 6, "underline negative"); - - current := normal; - current.Attr.Bold_Character := not current.Attr.Bold_Character; - current.Attr.Under_Line := not current.Attr.Under_Line; - current.Attr.Reverse_Video := not current.Attr.Reverse_Video; - Set_Background (Ch => current); - xAdd (14, 45, "bold underline negative"); - - current := normal; - current.Attr.Blink := not current.Attr.Blink; - current.Attr.Reverse_Video := not current.Attr.Reverse_Video; - Set_Background (Ch => current); - xAdd (16, 1, "blink negative"); - - current := normal; - current.Attr.Bold_Character := not current.Attr.Bold_Character; - current.Attr.Blink := not current.Attr.Blink; - current.Attr.Reverse_Video := not current.Attr.Reverse_Video; - Set_Background (Ch => current); - xAdd (16, 40, "bold blink negative"); - - current := normal; - current.Attr.Under_Line := not current.Attr.Under_Line; - current.Attr.Blink := not current.Attr.Blink; - current.Attr.Reverse_Video := not current.Attr.Reverse_Video; - Set_Background (Ch => current); - xAdd (18, 6, "underline blink negative"); - - current := normal; - current.Attr.Bold_Character := not current.Attr.Bold_Character; - current.Attr.Under_Line := not current.Attr.Under_Line; - current.Attr.Blink := not current.Attr.Blink; - current.Attr.Reverse_Video := not current.Attr.Reverse_Video; - Set_Background (Ch => current); - xAdd (18, 45, "bold underline blink negative"); - - Set_Background (Ch => normal); - Move_Cursor (Line => Lines - 2, Column => 1); - if pass then - Add (Str => "Dark"); - else - Add (Str => "Light"); - end if; - Add (Str => " background. "); - Clear_To_End_Of_Line; - Pause; - end loop; - - Set_Background (Ch => Blank2); - Erase; - End_Windows; - -end ncurses2.test_sgr_attributes; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-test_sgr_attributes.ads b/ncurses-5.3/Ada95/samples/ncurses2-test_sgr_attributes.ads deleted file mode 100644 index 7e65327..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-test_sgr_attributes.ads +++ /dev/null @@ -1,41 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -procedure ncurses2.test_sgr_attributes; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-trace_set.adb b/ncurses-5.3/Ada95/samples/ncurses2-trace_set.adb deleted file mode 100644 index 339c140..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-trace_set.adb +++ /dev/null @@ -1,481 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses2.trace_set -- --- -- --- 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$ --- 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) 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) return Boolean is - i, p : Item; - changed : Boolean; - c, v : Key_Code; - begin - loop - changed := False; - 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 : 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; - 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; - - while run_trace_menu (m) loop - null; - end loop; - - newtrace := Trace_Disable; - for n in t_tbl'Range loop - ip := Items (m, n); - if Value (ip) then - mask := t_tbl (n).mask; - newtrace := trace_or (newtrace, mask); - end if; - end loop; - - Trace_On (newtrace); - Trace_Put ("trace level interactively set to " & - tracetrace (nc_tracing)); - - Move_Cursor (Line => Lines - 4, Column => 0); - Add (Str => "Trace level is "); - Add (Str => tracetrace (nc_tracing)); - Add (Ch => newl); - Pause; -- was just Add(); Getchar - - Post (m, False); - -- menuwin has subwindows I think, which makes an error. - declare begin - Delete (menuwin); - exception when Curses_Exception => null; end; - - -- free_menu(m); - -- free_item() -end ncurses2.trace_set; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-trace_set.ads b/ncurses-5.3/Ada95/samples/ncurses2-trace_set.ads deleted file mode 100644 index fd2b0ad..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-trace_set.ads +++ /dev/null @@ -1,41 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses2.trace_set -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -procedure ncurses2.trace_set; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-util.adb b/ncurses-5.3/Ada95/samples/ncurses2-util.adb deleted file mode 100644 index d771782..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-util.adb +++ /dev/null @@ -1,199 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses2.util -- --- -- --- 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$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses; use Terminal_Interface.Curses; - -with Ada.Text_IO; - -with Terminal_Interface.Curses; use Terminal_Interface.Curses; -pragma Warnings (Off); -with Terminal_Interface.Curses.Aux; -pragma Warnings (On); - -with Terminal_Interface.Curses.Trace; use Terminal_Interface.Curses.Trace; - -with Ada.Text_IO; use Ada.Text_IO; - -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 - x : Key_Code; - begin - x := Getchar (win); - end Getchar; - - - procedure Pause is - begin - Move_Cursor (Line => Lines - 1, Column => 0); - Add (Str => "Press any key to continue... "); - Getchar; - end Pause; - - - procedure Cannot (s : String) is - use Interfaces.C; - use Interfaces.C.Strings; - use Terminal_Interface.Curses.Aux; - function getenv (x : char_array) return chars_ptr; - pragma Import (C, getenv, "getenv"); - tmp1 : char_array (0 .. 10); - package p is new ncurses2.genericPuts (1024); - use p; - use p.BS; - - tmpb : BS.Bounded_String; - - Length : size_t; - begin - To_C ("TERM", tmp1, Length); - Fill_String (getenv (tmp1), tmpb); - Add (Ch => newl); - myAdd (Str => "This " & tmpb & " terminal " & s); - Pause; - end Cannot; - - procedure ShellOut (message : Boolean) is - use Interfaces.C; - Txt : char_array (0 .. 10); - Length : size_t; - procedure system (x : char_array); - pragma Import (C, system, "system"); - begin - To_C ("sh", Txt, Length); - if message then - Add (Str => "Shelling out..."); - end if; - Save_Curses_Mode (Mode => Curses); - End_Windows; - system (Txt); - if message then - Add (Str => "returned from shellout."); - Add (Ch => newl); - end if; - Refresh; - end ShellOut; - - - - function Is_Digit (c : Key_Code) return Boolean is - begin - if c >= 16#100# then - return False; - else - return Ada.Characters.Handling.Is_Digit (Character'Val (c)); - end if; - end Is_Digit; - - procedure P (s : String) is - begin - Add (Str => s); - Add (Ch => newl); - end P; - - - function Code_To_Char (c : Key_Code) return Character is - begin - if c > Character'Pos (Character'Last) then - return Character'Val (0); - -- maybe raise exception? - else - return Character'Val (c); - end if; - end Code_To_Char; - - -- This was untestable due to a bug in GNAT (3.12p) - -- Hmm, what bug? I don't remember. - function ctoi (c : Character) return Integer is - begin - return Character'Pos (c) - Character'Pos ('0'); - end ctoi; - -end ncurses2.util; diff --git a/ncurses-5.3/Ada95/samples/ncurses2-util.ads b/ncurses-5.3/Ada95/samples/ncurses2-util.ads deleted file mode 100644 index d9df609..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-util.ads +++ /dev/null @@ -1,79 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses2.util -- --- -- --- 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$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses; use Terminal_Interface.Curses; - -with Ada.Text_IO; -package ncurses2.util is - - Blank : constant Character := ' '; - Blank2 : constant Attributed_Character := - (Ch => Blank, Attr => Normal_Video, Color => Color_Pair'First); - - - newl : constant Character := Character'Val (10); - - function CTRL (c : Character) return Key_Code; - - function CTRL (c : Character) return Character; - - function Getchar (win : Window := Standard_Window) return Key_Code; - - procedure Getchar (win : Window := Standard_Window); - - procedure Pause; - - - procedure Cannot (s : String); - - procedure ShellOut (message : Boolean); - - - package Int_IO is new Ada.Text_IO.Integer_IO (Integer); - - - function Is_Digit (c : Key_Code) return Boolean; - - procedure P (s : String); - - function Code_To_Char (c : Key_Code) return Character; - function ctoi (c : Character) return Integer; -end ncurses2.util; - diff --git a/ncurses-5.3/Ada95/samples/ncurses2.ads b/ncurses-5.3/Ada95/samples/ncurses2.ads deleted file mode 100644 index 8eb8aa4..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2.ads +++ /dev/null @@ -1,44 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- - -package ncurses2 is - pragma Pure (ncurses2); -end ncurses2; diff --git a/ncurses-5.3/Ada95/samples/rain.adb b/ncurses-5.3/Ada95/samples/rain.adb deleted file mode 100644 index 7e787e2..0000000 --- a/ncurses-5.3/Ada95/samples/rain.adb +++ /dev/null @@ -1,163 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Rain -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Laurent Pautet <pautet@gnat.com> --- Modified by: Juergen Pfeifer, 1997 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- --- -- -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; - - 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); - - 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; - while 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; - - Refresh; - Nap_Milli_Seconds (50); - end loop; - - Visibility := Normal; - Set_Cursor_Visibility (Visibility); - End_Windows; - -end Rain; diff --git a/ncurses-5.3/Ada95/samples/rain.ads b/ncurses-5.3/Ada95/samples/rain.ads deleted file mode 100644 index f8b5c38..0000000 --- a/ncurses-5.3/Ada95/samples/rain.ads +++ /dev/null @@ -1,44 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Rain -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Laurent Pautet <pautet@gnat.com> --- Modified by: Juergen Pfeifer, 1997 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- --- -- -procedure Rain; diff --git a/ncurses-5.3/Ada95/samples/sample-curses_demo-attributes.adb b/ncurses-5.3/Ada95/samples/sample-curses_demo-attributes.adb deleted file mode 100644 index 7043973..0000000 --- a/ncurses-5.3/Ada95/samples/sample-curses_demo-attributes.adb +++ /dev/null @@ -1,123 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Curses_Demo.Attributes -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses; use Terminal_Interface.Curses; -with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels; - -with Sample.Manifest; use Sample.Manifest; -with Sample.Function_Key_Setting; use Sample.Function_Key_Setting; -with Sample.Keyboard_Handler; use Sample.Keyboard_Handler; -with Sample.Explanation; use Sample.Explanation; - -package body Sample.Curses_Demo.Attributes is - - procedure Demo - is - P : Panel := Create (Standard_Window); - K : Real_Key_Code; - begin - Set_Meta_Mode; - Set_KeyPad_Mode; - - Top (P); - - Push_Environment ("ATTRIBDEMO"); - Default_Labels; - Notepad ("ATTRIB-PAD00"); - - Set_Character_Attributes (Attr => (others => False)); - Add (Line => 1, Column => Columns / 2 - 10, - Str => "This is NORMAL"); - - Set_Character_Attributes (Attr => (Stand_Out => True, - others => False)); - Add (Line => 2, Column => Columns / 2 - 10, - Str => "This is Stand_Out"); - - Set_Character_Attributes (Attr => (Under_Line => True, - others => False)); - Add (Line => 3, Column => Columns / 2 - 10, - Str => "This is Under_Line"); - - Set_Character_Attributes (Attr => (Reverse_Video => True, - others => False)); - Add (Line => 4, Column => Columns / 2 - 10, - Str => "This is Reverse_Video"); - - Set_Character_Attributes (Attr => (Blink => True, - others => False)); - Add (Line => 5, Column => Columns / 2 - 10, - Str => "This is Blink"); - - Set_Character_Attributes (Attr => (Dim_Character => True, - others => False)); - Add (Line => 6, Column => Columns / 2 - 10, - Str => "This is Dim_Character"); - - Set_Character_Attributes (Attr => (Bold_Character => True, - others => False)); - Add (Line => 7, Column => Columns / 2 - 10, - Str => "This is Bold_Character"); - - Refresh_Without_Update; - Update_Panels; Update_Screen; - - loop - K := Get_Key; - if K in Special_Key_Code'Range then - case K is - when QUIT_CODE => exit; - when HELP_CODE => Explain_Context; - when EXPLAIN_CODE => Explain ("ATTRIBKEYS"); - when others => null; - end case; - end if; - end loop; - - Pop_Environment; - Clear; - Refresh_Without_Update; - Delete (P); - Update_Panels; Update_Screen; - - end Demo; - -end Sample.Curses_Demo.Attributes; diff --git a/ncurses-5.3/Ada95/samples/sample-curses_demo-attributes.ads b/ncurses-5.3/Ada95/samples/sample-curses_demo-attributes.ads deleted file mode 100644 index c0d1e15..0000000 --- a/ncurses-5.3/Ada95/samples/sample-curses_demo-attributes.ads +++ /dev/null @@ -1,46 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Curses_Demo.Attributes -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package Sample.Curses_Demo.Attributes is - - procedure Demo; - -end Sample.Curses_Demo.Attributes; diff --git a/ncurses-5.3/Ada95/samples/sample-curses_demo-mouse.adb b/ncurses-5.3/Ada95/samples/sample-curses_demo-mouse.adb deleted file mode 100644 index a97c1ba..0000000 --- a/ncurses-5.3/Ada95/samples/sample-curses_demo-mouse.adb +++ /dev/null @@ -1,221 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Curses_Demo.Mouse -- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- 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, Integer (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 := (Integer (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, Integer (I), 1); - Refresh_Without_Update (W); - end loop; - end; - - Update_Panels; Update_Screen; - - loop - K := Get_Key; - if K in Special_Key_Code'Range then - case K is - when QUIT_CODE => exit; - when HELP_CODE => Explain_Context; - when EXPLAIN_CODE => Explain ("MOUSEKEYS"); - when Key_Mouse => Show_Mouse_Event; - when others => null; - end case; - end if; - end loop; - - for I in Ctl'Range loop - W := Get_Window (Ctl (I)); - Clear (W); - Delete (Ctl (I)); - Delete (W); - end loop; - - Clear (Frame); - Delete (Pan); - Delete (Msg); - Delete (Frame); - - Set_Cursor_Visibility (V); - End_Mouse (Mask); - - Pop_Environment; - Update_Panels; Update_Screen; - - end Demo; - -end Sample.Curses_Demo.Mouse; - diff --git a/ncurses-5.3/Ada95/samples/sample-curses_demo-mouse.ads b/ncurses-5.3/Ada95/samples/sample-curses_demo-mouse.ads deleted file mode 100644 index 44f36b5..0000000 --- a/ncurses-5.3/Ada95/samples/sample-curses_demo-mouse.ads +++ /dev/null @@ -1,46 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Curses_Demo.Mouse -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package Sample.Curses_Demo.Mouse is - - procedure Demo; - -end Sample.Curses_Demo.Mouse; diff --git a/ncurses-5.3/Ada95/samples/sample-curses_demo.adb b/ncurses-5.3/Ada95/samples/sample-curses_demo.adb deleted file mode 100644 index 483c8da..0000000 --- a/ncurses-5.3/Ada95/samples/sample-curses_demo.adb +++ /dev/null @@ -1,143 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Curses_Demo -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- 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 : User_Data_Access := new User_Data'(4711); - U2 : User_Data_Access; - - function My_Driver (M : Menu; - K : Key_Code; - Pan : Panel) return Boolean - is - Idx : constant Positive := Get_Index (Current (M)); - Result : Boolean := False; - begin - PUD.Set_User_Data (Pan, U1); -- set some user data, just for fun - if K in User_Key_Code'Range then - if K = QUIT then - Result := True; - elsif K = SELECT_ITEM then - if Idx in Itm'Range then - Hide (Pan); - Update_Panels; - end if; - case Idx is - when 1 => Sample.Curses_Demo.Attributes.Demo; - when 2 => Sample.Curses_Demo.Mouse.Demo; - when others => Not_Implemented; - end case; - if Idx in Itm'Range then - Top (Pan); - Show (Pan); - Update_Panels; - Update_Screen; - end if; - end if; - end if; - PUD.Get_User_Data (Pan, U2); -- get the user data - pragma Assert (U1.all = U2.all and then U1 = U2); - return Result; - end My_Driver; - - begin - - if (1 + Item_Count (M)) /= Itm'Length then - raise Constraint_Error; - end if; - - if not Has_Mouse then - declare - O : Item_Option_Set; - begin - Get_Options (Itm (2), O); - O.Selectable := False; - Set_Options (Itm (2), O); - end; - end if; - - Push_Environment ("CURSES00"); - Notepad ("CURSES-PAD00"); - Default_Labels; - Refresh_Soft_Label_Keys_Without_Update; - - Mh.Drive_Me (M, " Demo "); - Pop_Environment; - - Delete (M); - Free (Itm, True); - end Demo; - -end Sample.Curses_Demo; diff --git a/ncurses-5.3/Ada95/samples/sample-curses_demo.ads b/ncurses-5.3/Ada95/samples/sample-curses_demo.ads deleted file mode 100644 index 4ca976b..0000000 --- a/ncurses-5.3/Ada95/samples/sample-curses_demo.ads +++ /dev/null @@ -1,46 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Curses_Demo -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package Sample.Curses_Demo is - - procedure Demo; - -end Sample.Curses_Demo; diff --git a/ncurses-5.3/Ada95/samples/sample-explanation.adb b/ncurses-5.3/Ada95/samples/sample-explanation.adb deleted file mode 100644 index e24e8d5..0000000 --- a/ncurses-5.3/Ada95/samples/sample-explanation.adb +++ /dev/null @@ -1,409 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Explanation -- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- 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 : 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; - - 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; - diff --git a/ncurses-5.3/Ada95/samples/sample-explanation.ads b/ncurses-5.3/Ada95/samples/sample-explanation.ads deleted file mode 100644 index b7866e3..0000000 --- a/ncurses-5.3/Ada95/samples/sample-explanation.ads +++ /dev/null @@ -1,60 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- 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; diff --git a/ncurses-5.3/Ada95/samples/sample-form_demo-aux.adb b/ncurses-5.3/Ada95/samples/sample-form_demo-aux.adb deleted file mode 100644 index 5455478..0000000 --- a/ncurses-5.3/Ada95/samples/sample-form_demo-aux.adb +++ /dev/null @@ -1,260 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Form_Demo.Aux -- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- 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 : 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 : 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 K in User_Key_Code'Range and then K = QUIT then - if Driver (F, F_Validate_Field) = Form_Ok then - return True; - end if; - end if; - return False; - end Default_Driver; - - function Count_Active (F : Form) return Natural - is - N : Natural := 0; - O : Field_Option_Set; - H : constant Natural := Field_Count (F); - begin - if H > 0 then - for I in 1 .. H loop - Get_Options (Fields (F, I), O); - if O.Active then - N := N + 1; - end if; - end loop; - end if; - return N; - end Count_Active; - -end Sample.Form_Demo.Aux; diff --git a/ncurses-5.3/Ada95/samples/sample-form_demo-aux.ads b/ncurses-5.3/Ada95/samples/sample-form_demo-aux.ads deleted file mode 100644 index 636da60..0000000 --- a/ncurses-5.3/Ada95/samples/sample-form_demo-aux.ads +++ /dev/null @@ -1,93 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- 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; diff --git a/ncurses-5.3/Ada95/samples/sample-form_demo-handler.adb b/ncurses-5.3/Ada95/samples/sample-form_demo-handler.adb deleted file mode 100644 index f2c27d6..0000000 --- a/ncurses-5.3/Ada95/samples/sample-form_demo-handler.adb +++ /dev/null @@ -1,98 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Form_Demo.Handler -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- 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 : Key_Code := Aux.Get_Request (F, Pan, Handle_CRLF); - R : Driver_Result; - begin - if (K = 13 or else K = 10) and then not Handle_CRLF then - R := Unknown_Request; - else - R := Driver (F, K); - end if; - case R is - when Form_Ok => null; - when Unknown_Request => - if My_Driver (F, K, Pan) then - exit; - end if; - when others => Beep; - end case; - end; - end loop; - Set_Cursor_Visibility (V); - Aux.Destroy (F, Pan); - end Drive_Me; - -end Sample.Form_Demo.Handler; diff --git a/ncurses-5.3/Ada95/samples/sample-form_demo-handler.ads b/ncurses-5.3/Ada95/samples/sample-form_demo-handler.ads deleted file mode 100644 index 9b66686..0000000 --- a/ncurses-5.3/Ada95/samples/sample-form_demo-handler.ads +++ /dev/null @@ -1,65 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- 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; diff --git a/ncurses-5.3/Ada95/samples/sample-form_demo.adb b/ncurses-5.3/Ada95/samples/sample-form_demo.adb deleted file mode 100644 index 684ce6b..0000000 --- a/ncurses-5.3/Ada95/samples/sample-form_demo.adb +++ /dev/null @@ -1,135 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Form_Demo -- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- 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 Terminal_Interface.Curses.Forms.Form_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); - - package Frm_U is new - Terminal_Interface.Curses.Forms.Form_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 : My_Data := (Ch => 'X'); - - FA : Field_Array_Access := new Field_Array' - (Make (0, 14, "Sample Entry Form"), - Make (2, 0, "WeekdayEnumeration"), - Make (2, 20, "Numeric 1-10"), - Make (2, 34, "Only 'X'"), - Make (5, 0, "Multiple Lines offscreen(Scroll)"), - Make (Width => 18, Top => 3, Left => 0), - Make (Width => 12, Top => 3, Left => 20), - Make (Width => 12, Top => 3, Left => 34), - Make (Width => 46, Top => 6, Left => 0, Height => 4, Off_Screen => 2), - Null_Field - ); - - Frm : Terminal_Interface.Curses.Forms.Form := Create (FA); - - I_F : constant Integer_Field := (Precision => 0, - Lower_Limit => 1, - Upper_Limit => 10); - - F1, F2 : User_Access; - - package Fh is new Sample.Form_Demo.Handler (Default_Driver); - - begin - Push_Environment ("FORM00"); - Notepad ("FORM-PAD00"); - Default_Labels; - - Set_Field_Type (FA (6), Enum_Field); - Set_Field_Type (FA (7), I_F); - Set_Field_Type (FA (8), Mft); - - F1 := new User_Data'(Data => 4711); - Fld_U.Set_User_Data (FA (1), F1); - - Fh.Drive_Me (Frm); - - Fld_U.Get_User_Data (FA (1), F2); - pragma Assert (F1 = F2); - pragma Assert (F1.Data = F2.Data); - - Pop_Environment; - Delete (Frm); - - Free (FA, True); - end Demo; - -end Sample.Form_Demo; diff --git a/ncurses-5.3/Ada95/samples/sample-form_demo.ads b/ncurses-5.3/Ada95/samples/sample-form_demo.ads deleted file mode 100644 index d9cc8bd..0000000 --- a/ncurses-5.3/Ada95/samples/sample-form_demo.ads +++ /dev/null @@ -1,46 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Form_Demo -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package Sample.Form_Demo is - - procedure Demo; - -end Sample.Form_Demo; diff --git a/ncurses-5.3/Ada95/samples/sample-function_key_setting.adb b/ncurses-5.3/Ada95/samples/sample-function_key_setting.adb deleted file mode 100644 index 42f0fbf..0000000 --- a/ncurses-5.3/Ada95/samples/sample-function_key_setting.adb +++ /dev/null @@ -1,214 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Function_Key_Setting -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- 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; diff --git a/ncurses-5.3/Ada95/samples/sample-function_key_setting.ads b/ncurses-5.3/Ada95/samples/sample-function_key_setting.ads deleted file mode 100644 index 4858c4c..0000000 --- a/ncurses-5.3/Ada95/samples/sample-function_key_setting.ads +++ /dev/null @@ -1,83 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- 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; diff --git a/ncurses-5.3/Ada95/samples/sample-header_handler.adb b/ncurses-5.3/Ada95/samples/sample-header_handler.adb deleted file mode 100644 index d65e88c..0000000 --- a/ncurses-5.3/Ada95/samples/sample-header_handler.adb +++ /dev/null @@ -1,181 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Header_Handler -- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- 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 : Time := Clock; - Sec : Integer := Integer (Seconds (Now)); - Hour : Integer := Sec / 3600; - Minute : Integer := (Sec - Hour * 3600) / 60; - Mon : Month_Number := Month (Now); - D : Day_Number := Day (Now); - begin - if Header_Window /= Null_Window then - if Minute /= Display_Min or else Hour /= Display_Hour - or else Display_Day /= D or else Display_Month /= Mon then - Move_Cursor (Header_Window, 0, 0); - N_Out (D); Add (Header_Window, '.'); - Add (Header_Window, Month_Names (Mon)); - Move_Cursor (Header_Window, 1, 0); - N_Out (Hour); Add (Header_Window, ':'); - N_Out (Minute); - Display_Min := Minute; - Display_Hour := Hour; - Display_Month := Mon; - Display_Day := D; - Refresh_Without_Update (Header_Window); - if Do_Update then - Update_Screen; - end if; - end if; - end if; - end Internal_Update_Header_Window; - - -- This routine is called in the keyboard input timeout handler. So it will - -- periodically update the header line of the screen. - procedure Update_Header_Window - is - begin - Internal_Update_Header_Window (True); - end Update_Header_Window; - - function Init_Header_Window (Win : Window; - Columns : Column_Count) return Integer - is - Title : constant String := "Ada 95 ncurses Binding Sample"; - Pos : Column_Position; - begin - Header_Window := Win; - if Win /= Null_Window then - if Has_Colors then - Set_Background (Win => Win, - Ch => (Ch => ' ', - Color => Header_Color, - Attr => Normal_Video)); - Set_Character_Attributes (Win => Win, - Attr => Normal_Video, - Color => Header_Color); - Erase (Win); - end if; - Leave_Cursor_After_Update (Win, True); - Pos := Columns - Column_Position (Title'Length); - Add (Win, 0, Pos / 2, Title); - -- In this phase we must not allow a physical update, because - -- ncurses isn´t properly initialized at this point. - Internal_Update_Header_Window (False); - return 0; - else - return -1; - end if; - end Init_Header_Window; - -end Sample.Header_Handler; diff --git a/ncurses-5.3/Ada95/samples/sample-header_handler.ads b/ncurses-5.3/Ada95/samples/sample-header_handler.ads deleted file mode 100644 index ca2f2ab..0000000 --- a/ncurses-5.3/Ada95/samples/sample-header_handler.ads +++ /dev/null @@ -1,54 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Header_Handler -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses; use Terminal_Interface.Curses; - --- This package handles the painting of the header line of the screen. --- -package Sample.Header_Handler is - - procedure Init_Header_Handler; - -- Initialize the handler for the headerlines. - - procedure Update_Header_Window; - -- Update the information in the header window - -end Sample.Header_Handler; diff --git a/ncurses-5.3/Ada95/samples/sample-helpers.adb b/ncurses-5.3/Ada95/samples/sample-helpers.adb deleted file mode 100644 index ee7b8bb..0000000 --- a/ncurses-5.3/Ada95/samples/sample-helpers.adb +++ /dev/null @@ -1,70 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Helpers -- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses; use Terminal_Interface.Curses; - -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; diff --git a/ncurses-5.3/Ada95/samples/sample-helpers.ads b/ncurses-5.3/Ada95/samples/sample-helpers.ads deleted file mode 100644 index 7b8a1e1..0000000 --- a/ncurses-5.3/Ada95/samples/sample-helpers.ads +++ /dev/null @@ -1,55 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- 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; diff --git a/ncurses-5.3/Ada95/samples/sample-keyboard_handler.adb b/ncurses-5.3/Ada95/samples/sample-keyboard_handler.adb deleted file mode 100644 index 66dec91..0000000 --- a/ncurses-5.3/Ada95/samples/sample-keyboard_handler.adb +++ /dev/null @@ -1,192 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Keyboard_Handler -- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- 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 C in User_Key_Code'Range and then C = QUIT then - if Driver (F, F_Validate_Field) = Form_Ok then - K := Key_None; - return True; - end if; - elsif C in Normal_Key_Code'Range then - Ch := Character'Val (C); - if (Ch = LF or else Ch = CR) then - if Driver (F, F_Validate_Field) = Form_Ok then - declare - Buffer : String (1 .. Positive (Columns - 11)); - Cmdc : String (1 .. 8); - begin - Get_Buffer (Fld => FA (2), Str => Buffer); - Trim (Buffer, Left); - if Buffer (1) /= ' ' then - Cmdc := To_Upper (Buffer (Cmdc'Range)); - for I in Labels'Range loop - if Cmdc = Labels (I) then - K := Function_Key_Code - (Function_Key_Number (I)); - exit; - end if; - end loop; - end if; - return True; - end; - end if; - end if; - end if; - return False; - end My_Driver; - - begin - In_Command := True; - for I in Label_Number'Range loop - Get_Soft_Label_Key (I, Labels (I)); - Trim (Labels (I), Left); - Translate (Labels (I), Upper_Case_Map); - if Labels (I) (1) /= ' ' then - N := N + 1; - end if; - end loop; - if N > 0 then -- some labels were really set - declare - Enum_Info : Enumeration_Info (N); - Enum_Field : Enumeration_Field; - J : Positive := Enum_Info.Names'First; - - Frm : Form := Create (FA); - - begin - for I in Label_Number'Range loop - if Labels (I) (1) /= ' ' then - Enum_Info.Names (J) := new String'(Labels (I)); - J := J + 1; - end if; - end loop; - Enum_Field := Create (Enum_Info, True); - Set_Field_Type (FA (2), Enum_Field); - Set_Background (FA (2), Normal_Video); - - Fh.Drive_Me (Frm, Lines - 3, 0); - Delete (Frm); - Update_Panels; Update_Screen; - end; - end if; - Free (FA, True); - In_Command := False; - return K; - end Command; - - begin - Set_Timeout_Mode (Win, Delayed, 30000); - loop - K := Get_Keystroke (Win); - if K = Key_None then -- a timeout occured - Update_Header_Window; - elsif K = 3 and then not In_Command then -- CTRL-C - K := Command; - exit when K /= Key_None; - else - exit; - end if; - end loop; - return K; - end Get_Key; - - procedure Init_Keyboard_Handler is - begin - null; - end Init_Keyboard_Handler; - -end Sample.Keyboard_Handler; diff --git a/ncurses-5.3/Ada95/samples/sample-keyboard_handler.ads b/ncurses-5.3/Ada95/samples/sample-keyboard_handler.ads deleted file mode 100644 index 5021068..0000000 --- a/ncurses-5.3/Ada95/samples/sample-keyboard_handler.ads +++ /dev/null @@ -1,56 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Keyboard_Handler -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses; use Terminal_Interface.Curses; - --- This package contains a centralized keyboard handler used throughout --- this example. The handler establishes a timeout mechanism that provides --- periodical updates of the common header lines used in this example. --- -package Sample.Keyboard_Handler is - - function Get_Key (Win : Window := Standard_Window) return Real_Key_Code; - -- The central routine for handling keystrokes. - - procedure Init_Keyboard_Handler; - -- Initialize the keyboard - -end Sample.Keyboard_Handler; diff --git a/ncurses-5.3/Ada95/samples/sample-manifest.ads b/ncurses-5.3/Ada95/samples/sample-manifest.ads deleted file mode 100644 index e50b2a8..0000000 --- a/ncurses-5.3/Ada95/samples/sample-manifest.ads +++ /dev/null @@ -1,68 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Manifest -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses; use Terminal_Interface.Curses; - -package Sample.Manifest is - - QUIT : constant User_Key_Code := User_Key_Code'First; - SELECT_ITEM : constant User_Key_Code := QUIT + 1; - - FKEY_HELP : constant Label_Number := 1; - HELP_CODE : constant Special_Key_Code := Key_F1; - FKEY_EXPLAIN : constant Label_Number := 2; - EXPLAIN_CODE : constant Special_Key_Code := Key_F2; - FKEY_QUIT : constant Label_Number := 3; - QUIT_CODE : constant Special_Key_Code := Key_F3; - - Menu_Marker : constant String := "=> "; - - Default_Colors : constant Redefinable_Color_Pair := 1; - Menu_Fore_Color : constant Redefinable_Color_Pair := 2; - Menu_Back_Color : constant Redefinable_Color_Pair := 3; - Menu_Grey_Color : constant Redefinable_Color_Pair := 4; - Form_Fore_Color : constant Redefinable_Color_Pair := 5; - Form_Back_Color : constant Redefinable_Color_Pair := 6; - Notepad_Color : constant Redefinable_Color_Pair := 7; - Help_Color : constant Redefinable_Color_Pair := 8; - Header_Color : constant Redefinable_Color_Pair := 9; - -end Sample.Manifest; diff --git a/ncurses-5.3/Ada95/samples/sample-menu_demo-aux.adb b/ncurses-5.3/Ada95/samples/sample-menu_demo-aux.adb deleted file mode 100644 index 6bec082..0000000 --- a/ncurses-5.3/Ada95/samples/sample-menu_demo-aux.adb +++ /dev/null @@ -1,205 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Menu_Demo.Aux -- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- 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; - diff --git a/ncurses-5.3/Ada95/samples/sample-menu_demo-aux.ads b/ncurses-5.3/Ada95/samples/sample-menu_demo-aux.ads deleted file mode 100644 index 8c6f57f..0000000 --- a/ncurses-5.3/Ada95/samples/sample-menu_demo-aux.ads +++ /dev/null @@ -1,72 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- 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; diff --git a/ncurses-5.3/Ada95/samples/sample-menu_demo-handler.adb b/ncurses-5.3/Ada95/samples/sample-menu_demo-handler.adb deleted file mode 100644 index fd241a1..0000000 --- a/ncurses-5.3/Ada95/samples/sample-menu_demo-handler.adb +++ /dev/null @@ -1,108 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Menu_Demo.Handler -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- 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 : Driver_Result := Driver (M, K); - begin - case R is - when Menu_Ok => null; - when Unknown_Request => - declare - I : constant Item := Current (M); - O : Item_Option_Set; - begin - if K = Key_Mouse then - K := SELECT_ITEM; - end if; - Get_Options (I, O); - if K = SELECT_ITEM and then not O.Selectable then - Beep; - else - if My_Driver (M, K, Pan) then - exit; - end if; - end if; - end; - when others => Beep; - end case; - end; - end loop; - End_Mouse (Old); - Aux.Destroy (M, Pan); - end Drive_Me; - -end Sample.Menu_Demo.Handler; diff --git a/ncurses-5.3/Ada95/samples/sample-menu_demo-handler.ads b/ncurses-5.3/Ada95/samples/sample-menu_demo-handler.ads deleted file mode 100644 index bfb4995..0000000 --- a/ncurses-5.3/Ada95/samples/sample-menu_demo-handler.ads +++ /dev/null @@ -1,65 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- 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; diff --git a/ncurses-5.3/Ada95/samples/sample-menu_demo.adb b/ncurses-5.3/Ada95/samples/sample-menu_demo.adb deleted file mode 100644 index f70e9c7..0000000 --- a/ncurses-5.3/Ada95/samples/sample-menu_demo.adb +++ /dev/null @@ -1,391 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Menu_Demo -- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses; use Terminal_Interface.Curses; -with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels; -with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus; -with Terminal_Interface.Curses.Menus.Menu_User_Data; -with Terminal_Interface.Curses.Menus.Item_User_Data; - -with Sample.Manifest; use Sample.Manifest; -with Sample.Function_Key_Setting; use Sample.Function_Key_Setting; -with Sample.Menu_Demo.Handler; -with Sample.Helpers; use Sample.Helpers; -with Sample.Explanation; use Sample.Explanation; - -package body Sample.Menu_Demo is - - package Spacing_Demo is - procedure Spacing_Test; - end Spacing_Demo; - - package body Spacing_Demo is - - procedure Spacing_Test - is - function My_Driver (M : Menu; - K : Key_Code; - P : Panel) return Boolean; - - procedure Set_Option_Key; - procedure Set_Select_Key; - procedure Set_Description_Key; - procedure Set_Hide_Key; - - package Mh is new Sample.Menu_Demo.Handler (My_Driver); - - I : Item_Array_Access := new Item_Array' - (New_Item ("January", "31 Days"), - New_Item ("February", "28/29 Days"), - New_Item ("March", "31 Days"), - New_Item ("April", "30 Days"), - New_Item ("May", "31 Days"), - New_Item ("June", "30 Days"), - New_Item ("July", "31 Days"), - New_Item ("August", "31 Days"), - New_Item ("September", "30 Days"), - New_Item ("October", "31 Days"), - New_Item ("November", "30 Days"), - New_Item ("December", "31 Days"), - Null_Item); - - M : Menu := New_Menu (I); - Flip_State : Boolean := True; - Hide_Long : Boolean := False; - - type Format_Code is (Four_By_1, Four_By_2, Four_By_3); - type Operations is (Flip, Reorder, Reformat, Reselect, Describe); - - type Change is array (Operations) of Boolean; - pragma Pack (Change); - No_Change : constant Change := Change'(others => False); - - Current_Format : Format_Code := Four_By_1; - To_Change : Change := No_Change; - - function My_Driver (M : Menu; - K : Key_Code; - P : Panel) return Boolean - is - begin - To_Change := No_Change; - if K in User_Key_Code'Range then - if K = QUIT then - return True; - end if; - end if; - if K in Special_Key_Code'Range then - case K is - when Key_F4 => - To_Change (Flip) := True; - return True; - when Key_F5 => - To_Change (Reformat) := True; - Current_Format := Four_By_1; - return True; - when Key_F6 => - To_Change (Reformat) := True; - Current_Format := Four_By_2; - return True; - when Key_F7 => - To_Change (Reformat) := True; - Current_Format := Four_By_3; - return True; - when Key_F8 => - To_Change (Reorder) := True; - return True; - when Key_F9 => - To_Change (Reselect) := True; - return True; - when Key_F10 => - if Current_Format /= Four_By_3 then - To_Change (Describe) := True; - return True; - else - return False; - end if; - when Key_F11 => - Hide_Long := not Hide_Long; - declare - O : Item_Option_Set; - begin - for J in I'Range loop - Get_Options (I (J), O); - O.Selectable := True; - if Hide_Long then - case J is - when 1 | 3 | 5 | 7 | 8 | 10 | 12 => - O.Selectable := False; - when others => null; - end case; - end if; - Set_Options (I (J), O); - end loop; - end; - return False; - when others => null; - end case; - end if; - return False; - end My_Driver; - - procedure Set_Option_Key - is - O : Menu_Option_Set; - begin - if Current_Format = Four_By_1 then - Set_Soft_Label_Key (8, ""); - else - Get_Options (M, O); - if O.Row_Major_Order then - Set_Soft_Label_Key (8, "O-Col"); - else - Set_Soft_Label_Key (8, "O-Row"); - end if; - end if; - Refresh_Soft_Label_Keys_Without_Update; - end Set_Option_Key; - - procedure Set_Select_Key - is - O : Menu_Option_Set; - begin - Get_Options (M, O); - if O.One_Valued then - Set_Soft_Label_Key (9, "Multi"); - else - Set_Soft_Label_Key (9, "Singl"); - end if; - Refresh_Soft_Label_Keys_Without_Update; - end Set_Select_Key; - - procedure Set_Description_Key - is - O : Menu_Option_Set; - begin - if Current_Format = Four_By_3 then - Set_Soft_Label_Key (10, ""); - else - Get_Options (M, O); - if O.Show_Descriptions then - Set_Soft_Label_Key (10, "-Desc"); - else - Set_Soft_Label_Key (10, "+Desc"); - end if; - end if; - Refresh_Soft_Label_Keys_Without_Update; - end Set_Description_Key; - - procedure Set_Hide_Key - is - begin - if Hide_Long then - Set_Soft_Label_Key (11, "Enab"); - else - Set_Soft_Label_Key (11, "Disab"); - end if; - Refresh_Soft_Label_Keys_Without_Update; - end Set_Hide_Key; - - begin - Push_Environment ("MENU01"); - Notepad ("MENU-PAD01"); - Default_Labels; - Set_Soft_Label_Key (4, "Flip"); - Set_Soft_Label_Key (5, "4x1"); - Set_Soft_Label_Key (6, "4x2"); - Set_Soft_Label_Key (7, "4x3"); - Set_Option_Key; - Set_Select_Key; - Set_Description_Key; - Set_Hide_Key; - - Set_Format (M, 4, 1); - loop - Mh.Drive_Me (M); - exit when To_Change = No_Change; - if To_Change (Flip) then - if Flip_State then - Flip_State := False; - Set_Spacing (M, 3, 2, 0); - else - Flip_State := True; - Set_Spacing (M); - end if; - elsif To_Change (Reformat) then - case Current_Format is - when Four_By_1 => Set_Format (M, 4, 1); - when Four_By_2 => Set_Format (M, 4, 2); - when Four_By_3 => - declare - O : Menu_Option_Set; - begin - Get_Options (M, O); - O.Show_Descriptions := False; - Set_Options (M, O); - Set_Format (M, 4, 3); - end; - end case; - Set_Option_Key; - Set_Description_Key; - elsif To_Change (Reorder) then - declare - O : Menu_Option_Set; - begin - Get_Options (M, O); - O.Row_Major_Order := not O.Row_Major_Order; - Set_Options (M, O); - Set_Option_Key; - end; - elsif To_Change (Reselect) then - declare - O : Menu_Option_Set; - begin - Get_Options (M, O); - O.One_Valued := not O.One_Valued; - Set_Options (M, O); - Set_Select_Key; - end; - elsif To_Change (Describe) then - declare - O : Menu_Option_Set; - begin - Get_Options (M, O); - O.Show_Descriptions := not O.Show_Descriptions; - Set_Options (M, O); - Set_Description_Key; - end; - else - null; - end if; - end loop; - Set_Spacing (M); - Flip_State := True; - - Pop_Environment; - pragma Assert (Get_Index (Items (M, 1)) = Get_Index (I (1))); - Delete (M); - Free (I, True); - end Spacing_Test; - end Spacing_Demo; - - procedure Demo - is - -- We use this datatype only to test the instantiation of - -- the Menu_User_Data generic package. No functionality - -- behind it. - type User_Data is new Integer; - type User_Data_Access is access User_Data; - - -- Those packages are only instantiated to test the usability. - -- No real functionality is shown in the demo. - package MUD is new Menu_User_Data (User_Data, User_Data_Access); - package IUD is new Item_User_Data (User_Data, User_Data_Access); - - function My_Driver (M : Menu; - K : Key_Code; - P : Panel) return Boolean; - - package Mh is new Sample.Menu_Demo.Handler (My_Driver); - - Itm : Item_Array_Access := new Item_Array' - (New_Item ("Menu Layout Options"), - New_Item ("Demo of Hook functions"), - Null_Item); - M : Menu := New_Menu (Itm); - - U1 : User_Data_Access := new User_Data'(4711); - U2 : User_Data_Access; - U3 : User_Data_Access := new User_Data'(4712); - U4 : User_Data_Access; - - function My_Driver (M : Menu; - K : Key_Code; - P : Panel) return Boolean - is - Idx : constant Positive := Get_Index (Current (M)); - begin - if K in User_Key_Code'Range then - if K = QUIT then - return True; - elsif K = SELECT_ITEM then - if Idx in Itm'Range then - Hide (P); - Update_Panels; - end if; - case Idx is - when 1 => Spacing_Demo.Spacing_Test; - when others => Not_Implemented; - end case; - if Idx in Itm'Range then - Top (P); - Show (P); - Update_Panels; - Update_Screen; - end if; - end if; - end if; - return False; - end My_Driver; - begin - Push_Environment ("MENU00"); - Notepad ("MENU-PAD00"); - Default_Labels; - Refresh_Soft_Label_Keys_Without_Update; - Set_Pad_Character (M, '|'); - - MUD.Set_User_Data (M, U1); - IUD.Set_User_Data (Itm (1), U3); - - Mh.Drive_Me (M); - - MUD.Get_User_Data (M, U2); - pragma Assert (U1 = U2 and U1.all = 4711); - - IUD.Get_User_Data (Itm (1), U4); - pragma Assert (U3 = U4 and U3.all = 4712); - - Pop_Environment; - Delete (M); - Free (Itm, True); - end Demo; - -end Sample.Menu_Demo; diff --git a/ncurses-5.3/Ada95/samples/sample-menu_demo.ads b/ncurses-5.3/Ada95/samples/sample-menu_demo.ads deleted file mode 100644 index fa12e6f..0000000 --- a/ncurses-5.3/Ada95/samples/sample-menu_demo.ads +++ /dev/null @@ -1,46 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Menu_Demo -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package Sample.Menu_Demo is - - procedure Demo; - -end Sample.Menu_Demo; diff --git a/ncurses-5.3/Ada95/samples/sample-my_field_type.adb b/ncurses-5.3/Ada95/samples/sample-my_field_type.adb deleted file mode 100644 index 0251f7f..0000000 --- a/ncurses-5.3/Ada95/samples/sample-my_field_type.adb +++ /dev/null @@ -1,66 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.My_Field_Type -- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses.Forms; use Terminal_Interface.Curses.Forms; - --- This is a very simple user defined field type. It accepts only a --- defined character as input into the field. --- -package body Sample.My_Field_Type is - - -- That's simple. There are no field validity checks. - function Field_Check (Fld : Field; - Typ : My_Data) return Boolean - is - begin - return True; - end Field_Check; - - -- Check exactly against the specified character. - function Character_Check (Ch : Character; - Typ : My_Data) return Boolean - is - C : constant Character := Typ.Ch; - begin - return Ch = C; - end Character_Check; - -end Sample.My_Field_Type; diff --git a/ncurses-5.3/Ada95/samples/sample-my_field_type.ads b/ncurses-5.3/Ada95/samples/sample-my_field_type.ads deleted file mode 100644 index aca5442..0000000 --- a/ncurses-5.3/Ada95/samples/sample-my_field_type.ads +++ /dev/null @@ -1,63 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.My_Field_Type -- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses.Forms; use Terminal_Interface.Curses.Forms; -with Terminal_Interface.Curses.Forms.Field_Types.User; -use Terminal_Interface.Curses.Forms.Field_Types.User; - --- This is a very simple user defined field type. It accepts only a --- defined character as input into the field. --- -package Sample.My_Field_Type is - - type My_Data is new User_Defined_Field_Type with - record - Ch : Character; - end record; - - function Field_Check (Fld : Field; - Typ : My_Data) return Boolean; - - function Character_Check (Ch : Character; - Typ : My_Data) return Boolean; - -end Sample.My_Field_Type; - diff --git a/ncurses-5.3/Ada95/samples/sample-text_io_demo.adb b/ncurses-5.3/Ada95/samples/sample-text_io_demo.adb deleted file mode 100644 index 5c6fbc7..0000000 --- a/ncurses-5.3/Ada95/samples/sample-text_io_demo.adb +++ /dev/null @@ -1,181 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Text_IO_Demo -- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Ada.Numerics.Generic_Elementary_Functions; -with Ada.Numerics.Complex_Types; -use Ada.Numerics.Complex_Types; - -with Terminal_Interface.Curses; use Terminal_Interface.Curses; -with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels; -with Terminal_Interface.Curses.Text_IO; -use Terminal_Interface.Curses.Text_IO; -with Terminal_Interface.Curses.Text_IO.Integer_IO; -with Terminal_Interface.Curses.Text_IO.Float_IO; -with Terminal_Interface.Curses.Text_IO.Enumeration_IO; -with Terminal_Interface.Curses.Text_IO.Complex_IO; -with Terminal_Interface.Curses.Text_IO.Fixed_IO; -with Terminal_Interface.Curses.Text_IO.Decimal_IO; -with Terminal_Interface.Curses.Text_IO.Modular_IO; - -with Sample.Manifest; use Sample.Manifest; -with Sample.Function_Key_Setting; use Sample.Function_Key_Setting; -with Sample.Keyboard_Handler; use Sample.Keyboard_Handler; -with Sample.Explanation; use Sample.Explanation; - -package body Sample.Text_IO_Demo is - - type Weekday is (Sunday, - Monday, - Tuesday, - Wednesday, - Thursday, - Friday, - Saturday); - - type Fix is delta 0.1 range 0.0 .. 4.0; - type Dec is delta 0.01 digits 5 range 0.0 .. 4.0; - type Md is mod 5; - - package Math is new - Ada.Numerics.Generic_Elementary_Functions (Float); - - package Int_IO is new - Terminal_Interface.Curses.Text_IO.Integer_IO (Integer); - use Int_IO; - - package Real_IO is new - Terminal_Interface.Curses.Text_IO.Float_IO (Float); - use Real_IO; - - package Enum_IO is new - Terminal_Interface.Curses.Text_IO.Enumeration_IO (Weekday); - use Enum_IO; - - package C_IO is new - Terminal_Interface.Curses.Text_IO.Complex_IO (Ada.Numerics.Complex_Types); - use C_IO; - - package F_IO is new - Terminal_Interface.Curses.Text_IO.Fixed_IO (Fix); - use F_IO; - - package D_IO is new - Terminal_Interface.Curses.Text_IO.Decimal_IO (Dec); - use D_IO; - - package M_IO is new - Terminal_Interface.Curses.Text_IO.Modular_IO (Md); - use M_IO; - - procedure Demo - is - W : Window; - P : Panel := Create (Standard_Window); - K : Real_Key_Code; - Im : Complex := (0.0, 1.0); - Fx : Fix := 3.14; - Dc : Dec := 2.72; - L : Md; - - begin - Push_Environment ("TEXTIO"); - Default_Labels; - Notepad ("TEXTIO-PAD00"); - - Set_Echo_Mode (False); - Set_Meta_Mode; - Set_KeyPad_Mode; - W := Sub_Window (Standard_Window, Lines - 2, Columns - 2, 1, 1); - Box; - Refresh_Without_Update; - Set_Meta_Mode (W); - Set_KeyPad_Mode (W); - Immediate_Update_Mode (W, True); - - Set_Window (W); - - for I in 1 .. 10 loop - Put ("Square root of "); - Put (Item => I, Width => 5); - Put (" is "); - Put (Item => Math.Sqrt (Float (I)), Exp => 0, Aft => 7); - New_Line; - end loop; - - for W in Weekday loop - Put (Item => W); Put (' '); - end loop; - New_Line; - - L := Md'First; - for I in 1 .. 2 loop - for J in Md'Range loop - Put (L); Put (' '); - L := L + 1; - end loop; - end loop; - New_Line; - - Put (Im); New_Line; - Put (Fx); New_Line; - Put (Dc); New_Line; - - loop - K := Get_Key; - if K in Special_Key_Code'Range then - case K is - when QUIT_CODE => exit; - when HELP_CODE => Explain_Context; - when EXPLAIN_CODE => Explain ("TEXTIOKEYS"); - when others => null; - end case; - end if; - end loop; - - Set_Window (Null_Window); - Erase; Refresh_Without_Update; - Delete (P); - Delete (W); - - Pop_Environment; - end Demo; - -end Sample.Text_IO_Demo; diff --git a/ncurses-5.3/Ada95/samples/sample-text_io_demo.ads b/ncurses-5.3/Ada95/samples/sample-text_io_demo.ads deleted file mode 100644 index fa303cd..0000000 --- a/ncurses-5.3/Ada95/samples/sample-text_io_demo.ads +++ /dev/null @@ -1,46 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Text_IO_Demo -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package Sample.Text_IO_Demo is - - procedure Demo; - -end Sample.Text_IO_Demo; diff --git a/ncurses-5.3/Ada95/samples/sample.adb b/ncurses-5.3/Ada95/samples/sample.adb deleted file mode 100644 index 1df4562..0000000 --- a/ncurses-5.3/Ada95/samples/sample.adb +++ /dev/null @@ -1,219 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample -- --- -- --- 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Text_IO; - -with Ada.Exceptions; use Ada.Exceptions; - -with Terminal_Interface.Curses; use Terminal_Interface.Curses; -with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels; -with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus; -with Terminal_Interface.Curses.Menus.Menu_User_Data; -with Terminal_Interface.Curses.Menus.Item_User_Data; - -with Sample.Manifest; use Sample.Manifest; -with Sample.Function_Key_Setting; use Sample.Function_Key_Setting; -with Sample.Keyboard_Handler; use Sample.Keyboard_Handler; -with Sample.Header_Handler; use Sample.Header_Handler; -with Sample.Explanation; use Sample.Explanation; - -with Sample.Menu_Demo.Handler; -with Sample.Curses_Demo; -with Sample.Form_Demo; -with Sample.Menu_Demo; -with Sample.Text_IO_Demo; - -with GNAT.OS_Lib; - -package body Sample is - - type User_Data is - record - Data : Integer; - end record; - type User_Access is access User_Data; - - package Ud is new - Terminal_Interface.Curses.Menus.Menu_User_Data - (User_Data, User_Access); - - package Id is new - Terminal_Interface.Curses.Menus.Item_User_Data - (User_Data, User_Access); - - procedure Whow is - procedure Main_Menu; - procedure Main_Menu - is - function My_Driver (M : Menu; - K : Key_Code; - Pan : Panel) return Boolean; - - package Mh is new Sample.Menu_Demo.Handler (My_Driver); - - I : Item_Array_Access := new Item_Array' - (New_Item ("Curses Core Demo"), - New_Item ("Menu Demo"), - New_Item ("Form Demo"), - New_Item ("Text IO Demo"), - Null_Item); - - M : Menu := New_Menu (I); - - D1, D2 : User_Access; - I1, I2 : User_Access; - - function My_Driver (M : Menu; - K : Key_Code; - Pan : Panel) return Boolean - is - Idx : constant Positive := Get_Index (Current (M)); - begin - if K in User_Key_Code'Range then - if K = QUIT then - return True; - elsif K = SELECT_ITEM then - if Idx in 1 .. 4 then - Hide (Pan); - Update_Panels; - end if; - case Idx is - when 1 => Sample.Curses_Demo.Demo; - when 2 => Sample.Menu_Demo.Demo; - when 3 => Sample.Form_Demo.Demo; - when 4 => Sample.Text_IO_Demo.Demo; - when others => null; - end case; - if Idx in 1 .. 4 then - Top (Pan); - Show (Pan); - Update_Panels; - Update_Screen; - end if; - end if; - end if; - return False; - end My_Driver; - - begin - - if (1 + Item_Count (M)) /= I'Length then - raise Constraint_Error; - end if; - - D1 := new User_Data'(Data => 4711); - Ud.Set_User_Data (M, D1); - - I1 := new User_Data'(Data => 1174); - Id.Set_User_Data (I (1), I1); - - Set_Spacing (Men => M, Row => 2); - - Default_Labels; - Notepad ("MAINPAD"); - - Mh.Drive_Me (M, " Demo "); - - Ud.Get_User_Data (M, D2); - pragma Assert (D1 = D2); - pragma Assert (D1.Data = D2.Data); - - Id.Get_User_Data (I (1), I2); - pragma Assert (I1 = I2); - pragma Assert (I1.Data = I2.Data); - - Delete (M); - Free (I, True); - end Main_Menu; - - begin - Initialize (PC_Style_With_Index); - Init_Header_Handler; - Init_Screen; - - if Has_Colors then - Start_Color; - - Init_Pair (Pair => Default_Colors, Fore => Black, Back => White); - Init_Pair (Pair => Menu_Back_Color, Fore => Black, Back => Cyan); - Init_Pair (Pair => Menu_Fore_Color, Fore => Red, Back => Cyan); - Init_Pair (Pair => Menu_Grey_Color, Fore => White, Back => Cyan); - Init_Pair (Pair => Notepad_Color, Fore => Black, Back => Yellow); - Init_Pair (Pair => Help_Color, Fore => Blue, Back => Cyan); - Init_Pair (Pair => Form_Back_Color, Fore => Black, Back => Cyan); - Init_Pair (Pair => Form_Fore_Color, Fore => Red, Back => Cyan); - Init_Pair (Pair => Header_Color, Fore => Black, Back => Green); - - Set_Background (Ch => (Color => Default_Colors, - Attr => Normal_Video, - Ch => ' ')); - Set_Character_Attributes (Attr => Normal_Video, - Color => Default_Colors); - Erase; - - Set_Soft_Label_Key_Attributes (Color => Header_Color); - -- This propagates the attributes to the label window - Clear_Soft_Label_Keys; Restore_Soft_Label_Keys; - end if; - - Init_Keyboard_Handler; - - Set_Echo_Mode (False); - Set_Raw_Mode; - Set_Meta_Mode; - Set_KeyPad_Mode; - - -- Initialize the Function Key Environment - -- We have some fixed key throughout this sample - Main_Menu; - End_Windows; - - exception - when Event : others => - Terminal_Interface.Curses.End_Windows; - Text_IO.Put ("Exception: "); - Text_IO.Put (Exception_Name (Event)); - Text_IO.New_Line; - GNAT.OS_Lib.OS_Exit (1); - - end Whow; - -end Sample; diff --git a/ncurses-5.3/Ada95/samples/sample.ads b/ncurses-5.3/Ada95/samples/sample.ads deleted file mode 100644 index 8789c19..0000000 --- a/ncurses-5.3/Ada95/samples/sample.ads +++ /dev/null @@ -1,44 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package Sample is - procedure Whow; -end Sample; diff --git a/ncurses-5.3/Ada95/samples/status.adb b/ncurses-5.3/Ada95/samples/status.adb deleted file mode 100644 index 0a45166..0000000 --- a/ncurses-5.3/Ada95/samples/status.adb +++ /dev/null @@ -1,58 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Status -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Laurent Pautet <pautet@gnat.com> --- Modified by: Juergen Pfeifer, 1997 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- --- This package has been contributed by Laurent Pautet <pautet@gnat.com> -- --- -- -package body Status is - - protected body Process is - procedure Stop is - begin - Done := True; - end Stop; - function Continue return Boolean is - begin - return not Done; - end Continue; - end Process; - -end Status; diff --git a/ncurses-5.3/Ada95/samples/status.ads b/ncurses-5.3/Ada95/samples/status.ads deleted file mode 100644 index 706e06d..0000000 --- a/ncurses-5.3/Ada95/samples/status.ads +++ /dev/null @@ -1,61 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Status -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Laurent Pautet <pautet@gnat.com> --- Modified by: Juergen Pfeifer, 1997 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- --- This package has been contributed by Laurent Pautet <pautet@gnat.com> -- --- -- -with Ada.Interrupts.Names; - -package Status is - - pragma Warnings (Off); -- the next pragma exists since 3.11p - pragma Unreserve_All_Interrupts; - pragma Warnings (On); - - protected Process is - procedure Stop; - function Continue return Boolean; - pragma Attach_Handler (Stop, Ada.Interrupts.Names.SIGINT); - private - Done : Boolean := False; - end Process; - -end Status; diff --git a/ncurses-5.3/Ada95/samples/tour.adb b/ncurses-5.3/Ada95/samples/tour.adb deleted file mode 100644 index 4477ee5..0000000 --- a/ncurses-5.3/Ada95/samples/tour.adb +++ /dev/null @@ -1,47 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- tour -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Sample; use Sample; - -procedure Tour is -begin - Whow; -end Tour; diff --git a/ncurses-5.3/Ada95/samples/tour.ads b/ncurses-5.3/Ada95/samples/tour.ads deleted file mode 100644 index 5e84c5f..0000000 --- a/ncurses-5.3/Ada95/samples/tour.ads +++ /dev/null @@ -1,42 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Tour -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -procedure Tour; |