sample-text_io_demo.adb 6.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182
  1. ------------------------------------------------------------------------------
  2. -- --
  3. -- GNAT ncurses Binding Samples --
  4. -- --
  5. -- Sample.Text_IO_Demo --
  6. -- --
  7. -- B O D Y --
  8. -- --
  9. ------------------------------------------------------------------------------
  10. -- Copyright (c) 1998-2004,2006 Free Software Foundation, Inc. --
  11. -- --
  12. -- Permission is hereby granted, free of charge, to any person obtaining a --
  13. -- copy of this software and associated documentation files (the --
  14. -- "Software"), to deal in the Software without restriction, including --
  15. -- without limitation the rights to use, copy, modify, merge, publish, --
  16. -- distribute, distribute with modifications, sublicense, and/or sell --
  17. -- copies of the Software, and to permit persons to whom the Software is --
  18. -- furnished to do so, subject to the following conditions: --
  19. -- --
  20. -- The above copyright notice and this permission notice shall be included --
  21. -- in all copies or substantial portions of the Software. --
  22. -- --
  23. -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
  24. -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
  25. -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
  26. -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
  27. -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
  28. -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
  29. -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
  30. -- --
  31. -- Except as contained in this notice, the name(s) of the above copyright --
  32. -- holders shall not be used in advertising or otherwise to promote the --
  33. -- sale, use or other dealings in this Software without prior written --
  34. -- authorization. --
  35. ------------------------------------------------------------------------------
  36. -- Author: Juergen Pfeifer, 1996
  37. -- Version Control
  38. -- $Revision: 1.16 $
  39. -- $Date: 2006/06/25 14:30:22 $
  40. -- Binding Version 01.00
  41. ------------------------------------------------------------------------------
  42. with Ada.Numerics.Generic_Elementary_Functions;
  43. with Ada.Numerics.Complex_Types;
  44. use Ada.Numerics.Complex_Types;
  45. with Terminal_Interface.Curses; use Terminal_Interface.Curses;
  46. with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
  47. with Terminal_Interface.Curses.Text_IO;
  48. use Terminal_Interface.Curses.Text_IO;
  49. with Terminal_Interface.Curses.Text_IO.Integer_IO;
  50. with Terminal_Interface.Curses.Text_IO.Float_IO;
  51. with Terminal_Interface.Curses.Text_IO.Enumeration_IO;
  52. with Terminal_Interface.Curses.Text_IO.Complex_IO;
  53. with Terminal_Interface.Curses.Text_IO.Fixed_IO;
  54. with Terminal_Interface.Curses.Text_IO.Decimal_IO;
  55. with Terminal_Interface.Curses.Text_IO.Modular_IO;
  56. with Sample.Manifest; use Sample.Manifest;
  57. with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
  58. with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
  59. with Sample.Explanation; use Sample.Explanation;
  60. package body Sample.Text_IO_Demo is
  61. type Weekday is (Sunday,
  62. Monday,
  63. Tuesday,
  64. Wednesday,
  65. Thursday,
  66. Friday,
  67. Saturday);
  68. type Fix is delta 0.1 range 0.0 .. 4.0;
  69. type Dec is delta 0.01 digits 5 range 0.0 .. 4.0;
  70. type Md is mod 5;
  71. package Math is new
  72. Ada.Numerics.Generic_Elementary_Functions (Float);
  73. package Int_IO is new
  74. Terminal_Interface.Curses.Text_IO.Integer_IO (Integer);
  75. use Int_IO;
  76. package Real_IO is new
  77. Terminal_Interface.Curses.Text_IO.Float_IO (Float);
  78. use Real_IO;
  79. package Enum_IO is new
  80. Terminal_Interface.Curses.Text_IO.Enumeration_IO (Weekday);
  81. use Enum_IO;
  82. package C_IO is new
  83. Terminal_Interface.Curses.Text_IO.Complex_IO (Ada.Numerics.Complex_Types);
  84. use C_IO;
  85. package F_IO is new
  86. Terminal_Interface.Curses.Text_IO.Fixed_IO (Fix);
  87. use F_IO;
  88. package D_IO is new
  89. Terminal_Interface.Curses.Text_IO.Decimal_IO (Dec);
  90. use D_IO;
  91. package M_IO is new
  92. Terminal_Interface.Curses.Text_IO.Modular_IO (Md);
  93. use M_IO;
  94. procedure Demo
  95. is
  96. W : Window;
  97. P : Panel := Create (Standard_Window);
  98. K : Real_Key_Code;
  99. Im : constant Complex := (0.0, 1.0);
  100. Fx : constant Dec := 3.14;
  101. Dc : constant Dec := 2.72;
  102. L : Md;
  103. begin
  104. Push_Environment ("TEXTIO");
  105. Default_Labels;
  106. Notepad ("TEXTIO-PAD00");
  107. Set_Echo_Mode (False);
  108. Set_Meta_Mode;
  109. Set_KeyPad_Mode;
  110. W := Sub_Window (Standard_Window, Lines - 2, Columns - 2, 1, 1);
  111. Box;
  112. Refresh_Without_Update;
  113. Set_Meta_Mode (W);
  114. Set_KeyPad_Mode (W);
  115. Immediate_Update_Mode (W, True);
  116. Set_Window (W);
  117. for I in 1 .. 10 loop
  118. Put ("Square root of ");
  119. Put (Item => I, Width => 5);
  120. Put (" is ");
  121. Put (Item => Math.Sqrt (Float (I)), Exp => 0, Aft => 7);
  122. New_Line;
  123. end loop;
  124. for W in Weekday loop
  125. Put (Item => W); Put (' ');
  126. end loop;
  127. New_Line;
  128. L := Md'First;
  129. for I in 1 .. 2 loop
  130. for J in Md'Range loop
  131. Put (L); Put (' ');
  132. L := L + 1;
  133. end loop;
  134. end loop;
  135. New_Line;
  136. Put (Im); New_Line;
  137. Put (Fx); New_Line;
  138. Put (Dc); New_Line;
  139. loop
  140. K := Get_Key;
  141. if K in Special_Key_Code'Range then
  142. case K is
  143. when QUIT_CODE => exit;
  144. when HELP_CODE => Explain_Context;
  145. when EXPLAIN_CODE => Explain ("TEXTIOKEYS");
  146. when others => null;
  147. end case;
  148. end if;
  149. end loop;
  150. Set_Window (Null_Window);
  151. Erase; Refresh_Without_Update;
  152. Delete (P);
  153. Delete (W);
  154. Pop_Environment;
  155. end Demo;
  156. end Sample.Text_IO_Demo;