1------------------------------------------------------------------------------ 2-- -- 3-- GNAT ncurses Binding Samples -- 4-- -- 5-- ncurses -- 6-- -- 7-- B O D Y -- 8-- -- 9------------------------------------------------------------------------------ 10-- Copyright 2020-2021,2024 Thomas E. Dickey -- 11-- Copyright 2000-2014,2015 Free Software Foundation, Inc. -- 12-- -- 13-- Permission is hereby granted, free of charge, to any person obtaining a -- 14-- copy of this software and associated documentation files (the -- 15-- "Software"), to deal in the Software without restriction, including -- 16-- without limitation the rights to use, copy, modify, merge, publish, -- 17-- distribute, distribute with modifications, sublicense, and/or sell -- 18-- copies of the Software, and to permit persons to whom the Software is -- 19-- furnished to do so, subject to the following conditions: -- 20-- -- 21-- The above copyright notice and this permission notice shall be included -- 22-- in all copies or substantial portions of the Software. -- 23-- -- 24-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- 25-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- 26-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- 27-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- 28-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- 29-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- 30-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- 31-- -- 32-- Except as contained in this notice, the name(s) of the above copyright -- 33-- holders shall not be used in advertising or otherwise to promote the -- 34-- sale, use or other dealings in this Software without prior written -- 35-- authorization. -- 36------------------------------------------------------------------------------ 37-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 38-- Version Control 39-- $Revision: 1.10 $ 40-- $Date: 2024/03/30 13:21:15 $ 41-- Binding Version 01.00 42------------------------------------------------------------------------------ 43with ncurses2.util; use ncurses2.util; 44with Terminal_Interface.Curses; use Terminal_Interface.Curses; 45 46-- test effects of overlapping windows 47 48procedure ncurses2.overlap_test is 49 50 procedure fillwin (win : Window; ch : Character); 51 procedure crosswin (win : Window; ch : Character); 52 53 procedure fillwin (win : Window; ch : Character) is 54 y1 : Line_Position; 55 x1 : Column_Position; 56 begin 57 Get_Size (win, y1, x1); 58 for y in 0 .. y1 - 1 loop 59 Move_Cursor (win, y, 0); 60 for x in 0 .. x1 - 1 loop 61 Add (win, Ch => ch); 62 end loop; 63 end loop; 64 exception 65 when Curses_Exception => null; 66 -- write to lower right corner 67 end fillwin; 68 69 procedure crosswin (win : Window; ch : Character) is 70 y1 : Line_Position; 71 x1 : Column_Position; 72 begin 73 Get_Size (win, y1, x1); 74 for y in 0 .. y1 - 1 loop 75 for x in 0 .. x1 - 1 loop 76 if (x > (x1 - 1) / 3 and x <= (2 * (x1 - 1)) / 3) or 77 (y > (y1 - 1) / 3 and y <= (2 * (y1 - 1)) / 3) 78 then 79 Move_Cursor (win, y, x); 80 Add (win, Ch => ch); 81 end if; 82 end loop; 83 end loop; 84 end crosswin; 85 86 -- In a 24x80 screen like some xterms are, the instructions will 87 -- be overwritten. 88 ch : Character; 89 win1 : Window := New_Window (9, 20, 3, 3); 90 win2 : Window := New_Window (9, 20, 9, 16); 91begin 92 Set_Raw_Mode (SwitchOn => True); 93 Refresh; 94 Move_Cursor (Line => 0, Column => 0); 95 Add (Str => "This test shows the behavior of wnoutrefresh() with " & 96 "respect to"); 97 Add (Ch => newl); 98 Add (Str => "the shared region of two overlapping windows A and B. " & 99 "The cross"); 100 Add (Ch => newl); 101 Add (Str => "pattern in each window does not overlap the other."); 102 Add (Ch => newl); 103 104 Move_Cursor (Line => 18, Column => 0); 105 Add (Str => "a = refresh A, then B, then doupdate. b = refresh B, " & 106 "then A, then doupdate"); 107 Add (Ch => newl); 108 Add (Str => "c = fill window A with letter A. d = fill window B " & 109 "with letter B."); 110 Add (Ch => newl); 111 Add (Str => "e = cross pattern in window A. f = cross pattern " & 112 "in window B."); 113 Add (Ch => newl); 114 Add (Str => "g = clear window A. h = clear window B."); 115 Add (Ch => newl); 116 Add (Str => "i = overwrite A onto B. j = overwrite " & 117 "B onto A."); 118 Add (Ch => newl); 119 Add (Str => "^Q/ESC = terminate test."); 120 121 loop 122 ch := Code_To_Char (Getchar); 123 exit when ch = CTRL ('Q') or ch = CTRL ('['); -- QUIT or ESCAPE 124 case ch is 125 when 'a' => -- refresh window A first, then B 126 Refresh_Without_Update (win1); 127 Refresh_Without_Update (win2); 128 Update_Screen; 129 when 'b' => -- refresh window B first, then A 130 Refresh_Without_Update (win2); 131 Refresh_Without_Update (win1); 132 Update_Screen; 133 when 'c' => -- fill window A so it is visible 134 fillwin (win1, 'A'); 135 when 'd' => -- fill window B so it is visible 136 fillwin (win2, 'B'); 137 when 'e' => -- cross test pattern in window A 138 crosswin (win1, 'A'); 139 when 'f' => -- cross test pattern in window B 140 crosswin (win2, 'B'); 141 when 'g' => -- clear window A 142 Clear (win1); 143 Move_Cursor (win1, 0, 0); 144 when 'h' => -- clear window B 145 Clear (win2); 146 Move_Cursor (win2, 0, 0); 147 when 'i' => -- overwrite A onto B 148 Overwrite (win1, win2); 149 when 'j' => -- overwrite B onto A 150 Overwrite (win2, win1); 151 when others => null; 152 end case; 153 end loop; 154 155 Delete (win2); 156 Delete (win1); 157 Erase; 158 End_Windows; 159end ncurses2.overlap_test; 160