?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
missing ncurses sources
[tomato.git] / release / src / router / libncurses / Ada95 / samples / ncurses2-acs_and_scroll.adb
blob00e9afc2607897d1f4ffeab15a10c96e90c08a34
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT ncurses Binding Samples --
4 -- --
5 -- ncurses --
6 -- --
7 -- B O D Y --
8 -- --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 2000-2009,2011 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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
37 -- Version Control
38 -- $Revision: 1.11 $
39 -- $Date: 2011/03/23 00:33:00 $
40 -- Binding Version 01.00
41 ------------------------------------------------------------------------------
42 -- Windows and scrolling tester.
43 -- Demonstrate windows
44
45 with Ada.Strings.Fixed;
46 with Ada.Strings;
47
48 with ncurses2.util; use ncurses2.util;
49 with ncurses2.genericPuts;
50 with Terminal_Interface.Curses; use Terminal_Interface.Curses;
51 with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
52 with Terminal_Interface.Curses.PutWin; use Terminal_Interface.Curses.PutWin;
53
54 with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
55 with Ada.Streams; use Ada.Streams;
56
57 procedure ncurses2.acs_and_scroll is
58
59 Macro_Quit : constant Key_Code := Character'Pos ('Q') mod 16#20#;
60 Macro_Escape : constant Key_Code := Character'Pos ('[') mod 16#20#;
61
62 Quit : constant Key_Code := CTRL ('Q');
63 Escape : constant Key_Code := CTRL ('[');
64
65 Botlines : constant Line_Position := 4;
66
67 type pair is record
68 y : Line_Position;
69 x : Column_Position;
70 end record;
71
72 type Frame;
73 type FrameA is access Frame;
74
75 f : File_Type;
76 dumpfile : constant String := "screendump";
77
78 procedure Outerbox (ul, lr : pair; onoff : Boolean);
79 function HaveKeyPad (w : Window) return Boolean;
80 function HaveScroll (w : Window) return Boolean;
81 procedure newwin_legend (curpw : Window);
82 procedure transient (curpw : Window; msg : String);
83 procedure newwin_report (win : Window := Standard_Window);
84 procedure selectcell (uli : Line_Position;
85 ulj : Column_Position;
86 lri : Line_Position;
87 lrj : Column_Position;
88 p : out pair;
89 b : out Boolean);
90 function getwindow return Window;
91 procedure newwin_move (win : Window;
92 dy : Line_Position;
93 dx : Column_Position);
94 function delete_framed (fp : FrameA; showit : Boolean) return FrameA;
95
96 -- A linked list
97 -- I wish there was a standard library linked list. Oh well.
98 type Frame is record
99 next, last : FrameA;
100 do_scroll : Boolean;
101 do_keypad : Boolean;
102 wind : Window;
103 end record;
104
105 current : FrameA;
106
107 c : Key_Code;
108
109 procedure Outerbox (ul, lr : pair; onoff : Boolean) is
110 begin
111 if onoff then
112 -- Note the fix of an obscure bug
113 -- try making a 1x1 box then enlarging it, the is a blank
114 -- upper left corner!
115 Add (Line => ul.y - 1, Column => ul.x - 1,
116 Ch => ACS_Map (ACS_Upper_Left_Corner));
117 Add (Line => ul.y - 1, Column => lr.x + 1,
118 Ch => ACS_Map (ACS_Upper_Right_Corner));
119 Add (Line => lr.y + 1, Column => lr.x + 1,
120 Ch => ACS_Map (ACS_Lower_Right_Corner));
121 Add (Line => lr.y + 1, Column => ul.x - 1,
122 Ch => ACS_Map (ACS_Lower_Left_Corner));
123
124 Move_Cursor (Line => ul.y - 1, Column => ul.x);
125 Horizontal_Line (Line_Symbol => ACS_Map (ACS_Horizontal_Line),
126 Line_Size => Integer (lr.x - ul.x) + 1);
127 Move_Cursor (Line => ul.y, Column => ul.x - 1);
128 Vertical_Line (Line_Symbol => ACS_Map (ACS_Vertical_Line),
129 Line_Size => Integer (lr.y - ul.y) + 1);
130 Move_Cursor (Line => lr.y + 1, Column => ul.x);
131 Horizontal_Line (Line_Symbol => ACS_Map (ACS_Horizontal_Line),
132 Line_Size => Integer (lr.x - ul.x) + 1);
133 Move_Cursor (Line => ul.y, Column => lr.x + 1);
134 Vertical_Line (Line_Symbol => ACS_Map (ACS_Vertical_Line),
135 Line_Size => Integer (lr.y - ul.y) + 1);
136 else
137 Add (Line => ul.y - 1, Column => ul.x - 1, Ch => ' ');
138 Add (Line => ul.y - 1, Column => lr.x + 1, Ch => ' ');
139 Add (Line => lr.y + 1, Column => lr.x + 1, Ch => ' ');
140 Add (Line => lr.y + 1, Column => ul.x - 1, Ch => ' ');
141
142 Move_Cursor (Line => ul.y - 1, Column => ul.x);
143 Horizontal_Line (Line_Symbol => Blank2,
144 Line_Size => Integer (lr.x - ul.x) + 1);
145 Move_Cursor (Line => ul.y, Column => ul.x - 1);
146 Vertical_Line (Line_Symbol => Blank2,
147 Line_Size => Integer (lr.y - ul.y) + 1);
148 Move_Cursor (Line => lr.y + 1, Column => ul.x);
149 Horizontal_Line (Line_Symbol => Blank2,
150 Line_Size => Integer (lr.x - ul.x) + 1);
151 Move_Cursor (Line => ul.y, Column => lr.x + 1);
152 Vertical_Line (Line_Symbol => Blank2,
153 Line_Size => Integer (lr.y - ul.y) + 1);
154 end if;
155 end Outerbox;
156
157 function HaveKeyPad (w : Window) return Boolean is
158 begin
159 return Get_KeyPad_Mode (w);
160 exception
161 when Curses_Exception => return False;
162 end HaveKeyPad;
163
164 function HaveScroll (w : Window) return Boolean is
165 begin
166 return Scrolling_Allowed (w);
167 exception
168 when Curses_Exception => return False;
169 end HaveScroll;
170
171 procedure newwin_legend (curpw : Window) is
172
173 package p is new genericPuts (200);
174 use p;
175 use p.BS;
176
177 type string_a is access String;
178
179 type rrr is record
180 msg : string_a;
181 code : Integer range 0 .. 3;
182 end record;
183
184 legend : constant array (Positive range <>) of rrr :=
185 (
186 (
187 new String'("^C = create window"), 0
188 ),
189 (
190 new String'("^N = next window"), 0
191 ),
192 (
193 new String'("^P = previous window"), 0
194 ),
195 (
196 new String'("^F = scroll forward"), 0
197 ),
198 (
199 new String'("^B = scroll backward"), 0
200 ),
201 (
202 new String'("^K = keypad(%s)"), 1
203 ),
204 (
205 new String'("^S = scrollok(%s)"), 2
206 ),
207 (
208 new String'("^W = save window to file"), 0
209 ),
210 (
211 new String'("^R = restore window"), 0
212 ),
213 (
214 new String'("^X = resize"), 0
215 ),
216 (
217 new String'("^Q%s = exit"), 3
218 )
219 );
220
221 buf : Bounded_String;
222 do_keypad : constant Boolean := HaveKeyPad (curpw);
223 do_scroll : constant Boolean := HaveScroll (curpw);
224
225 pos : Natural;
226
227 mypair : pair;
228
229 use Ada.Strings.Fixed;
230
231 begin
232 Move_Cursor (Line => Lines - 4, Column => 0);
233 for n in legend'Range loop
234 pos := Ada.Strings.Fixed.Index (Source => legend (n).msg.all,
235 Pattern => "%s");
236 -- buf := (others => ' ');
237 buf := To_Bounded_String (legend (n).msg.all);
238 case legend (n).code is
239 when 0 => null;
240 when 1 =>
241 if do_keypad then
242 Replace_Slice (buf, pos, pos + 1, "yes");
243 else
244 Replace_Slice (buf, pos, pos + 1, "no");
245 end if;
246 when 2 =>
247 if do_scroll then
248 Replace_Slice (buf, pos, pos + 1, "yes");
249 else
250 Replace_Slice (buf, pos, pos + 1, "no");
251 end if;
252 when 3 =>
253 if do_keypad then
254 Replace_Slice (buf, pos, pos + 1, "/ESC");
255 else
256 Replace_Slice (buf, pos, pos + 1, "");
257 end if;
258 end case;
259 Get_Cursor_Position (Line => mypair.y, Column => mypair.x);
260 if Columns < mypair.x + 3 + Column_Position (Length (buf)) then
261 Add (Ch => newl);
262 elsif n /= 1 then -- n /= legen'First
263 Add (Str => ", ");
264 end if;
265 myAdd (Str => buf);
266 end loop;
267 Clear_To_End_Of_Line;
268 end newwin_legend;
269
270 procedure transient (curpw : Window; msg : String) is
271 begin
272 newwin_legend (curpw);
273 if msg /= "" then
274 Add (Line => Lines - 1, Column => 0, Str => msg);
275 Refresh;
276 Nap_Milli_Seconds (1000);
277 end if;
278
279 Move_Cursor (Line => Lines - 1, Column => 0);
280
281 if HaveKeyPad (curpw) then
282 Add (Str => "Non-arrow");
283 else
284 Add (Str => "All other");
285 end if;
286 Add (Str => " characters are echoed, window should ");
287 if not HaveScroll (curpw) then
288 Add (Str => "not ");
289 end if;
290 Add (Str => "scroll");
291
292 Clear_To_End_Of_Line;
293 end transient;
294
295 procedure newwin_report (win : Window := Standard_Window) is
296 y : Line_Position;
297 x : Column_Position;
298 use Int_IO;
299 tmp2a : String (1 .. 2);
300 tmp2b : String (1 .. 2);
301 begin
302 if win /= Standard_Window then
303 transient (win, "");
304 end if;
305 Get_Cursor_Position (win, y, x);
306 Move_Cursor (Line => Lines - 1, Column => Columns - 17);
307 Put (tmp2a, Integer (y));
308 Put (tmp2b, Integer (x));
309 Add (Str => "Y = " & tmp2a & " X = " & tmp2b);
310 if win /= Standard_Window then
311 Refresh;
312 else
313 Move_Cursor (win, y, x);
314 end if;
315 end newwin_report;
316
317 procedure selectcell (uli : Line_Position;
318 ulj : Column_Position;
319 lri : Line_Position;
320 lrj : Column_Position;
321 p : out pair;
322 b : out Boolean) is
323 c : Key_Code;
324 res : pair;
325 i : Line_Position := 0;
326 j : Column_Position := 0;
327 si : constant Line_Position := lri - uli + 1;
328 sj : constant Column_Position := lrj - ulj + 1;
329 begin
330 res.y := uli;
331 res.x := ulj;
332 loop
333 Move_Cursor (Line => uli + i, Column => ulj + j);
334 newwin_report;
335
336 c := Getchar;
337 case c is
338 when
339 Macro_Quit |
340 Macro_Escape =>
341 -- on the same line macro calls interfere due to the # comment
342 -- this is needed because keypad off affects all windows.
343 -- try removing the ESCAPE and see what happens.
344 b := False;
345 return;
346 when KEY_UP =>
347 i := i + si - 1;
348 -- same as i := i - 1 because of Modulus arithmetic,
349 -- on Line_Position, which is a Natural
350 -- the C version uses this form too, interestingly.
351 when KEY_DOWN =>
352 i := i + 1;
353 when KEY_LEFT =>
354 j := j + sj - 1;
355 when KEY_RIGHT =>
356 j := j + 1;
357 when Key_Mouse =>
358 declare
359 event : Mouse_Event;
360 y : Line_Position;
361 x : Column_Position;
362 Button : Mouse_Button;
363 State : Button_State;
364
365 begin
366 event := Get_Mouse;
367 Get_Event (Event => event,
368 Y => y,
369 X => x,
370 Button => Button,
371 State => State);
372 if y > uli and x > ulj then
373 i := y - uli;
374 j := x - ulj;
375 -- same as when others =>
376 res.y := uli + i;
377 res.x := ulj + j;
378 p := res;
379 b := True;
380 return;
381 else
382 Beep;
383 end if;
384 end;
385 when others =>
386 res.y := uli + i;
387 res.x := ulj + j;
388 p := res;
389 b := True;
390 return;
391 end case;
392 i := i mod si;
393 j := j mod sj;
394 end loop;
395 end selectcell;
396
397 function getwindow return Window is
398 rwindow : Window;
399 ul, lr : pair;
400 result : Boolean;
401 begin
402 Move_Cursor (Line => 0, Column => 0);
403 Clear_To_End_Of_Line;
404 Add (Str => "Use arrows to move cursor, anything else to mark corner 1");
405 Refresh;
406 selectcell (2, 1, Lines - Botlines - 2, Columns - 2, ul, result);
407 if not result then
408 return Null_Window;
409 end if;
410 Add (Line => ul.y - 1, Column => ul.x - 1,
411 Ch => ACS_Map (ACS_Upper_Left_Corner));
412 Move_Cursor (Line => 0, Column => 0);
413 Clear_To_End_Of_Line;
414 Add (Str => "Use arrows to move cursor, anything else to mark corner 2");
415 Refresh;
416 selectcell (ul.y, ul.x, Lines - Botlines - 2, Columns - 2, lr, result);
417 if not result then
418 return Null_Window;
419 end if;
420
421 rwindow := Sub_Window (Number_Of_Lines => lr.y - ul.y + 1,
422 Number_Of_Columns => lr.x - ul.x + 1,
423 First_Line_Position => ul.y,
424 First_Column_Position => ul.x);
425
426 Outerbox (ul, lr, True);
427 Refresh;
428
429 Refresh (rwindow);
430
431 Move_Cursor (Line => 0, Column => 0);
432 Clear_To_End_Of_Line;
433 return rwindow;
434 end getwindow;
435
436 procedure newwin_move (win : Window;
437 dy : Line_Position;
438 dx : Column_Position) is
439 cur_y, max_y : Line_Position;
440 cur_x, max_x : Column_Position;
441 begin
442 Get_Cursor_Position (win, cur_y, cur_x);
443 Get_Size (win, max_y, max_x);
444 cur_x := Column_Position'Min (Column_Position'Max (cur_x + dx, 0),
445 max_x - 1);
446 cur_y := Line_Position'Min (Line_Position'Max (cur_y + dy, 0),
447 max_y - 1);
448
449 Move_Cursor (win, Line => cur_y, Column => cur_x);
450 end newwin_move;
451
452 function delete_framed (fp : FrameA; showit : Boolean) return FrameA is
453 np : FrameA;
454 begin
455 fp.all.last.all.next := fp.all.next;
456 fp.all.next.all.last := fp.all.last;
457
458 if showit then
459 Erase (fp.all.wind);
460 Refresh (fp.all.wind);
461 end if;
462 Delete (fp.all.wind);
463
464 if fp = fp.all.next then
465 np := null;
466 else
467 np := fp.all.next;
468 end if;
469 -- TODO free(fp);
470 return np;
471 end delete_framed;
472
473 Mask : Event_Mask := No_Events;
474 Mask2 : Event_Mask;
475
476 usescr : Window;
477
478 begin
479 if Has_Mouse then
480 Register_Reportable_Event (
481 Button => Left,
482 State => Clicked,
483 Mask => Mask);
484 Mask2 := Start_Mouse (Mask);
485 end if;
486 c := CTRL ('C');
487 Set_Raw_Mode (SwitchOn => True);
488 loop
489 transient (Standard_Window, "");
490 case c is
491 when Character'Pos ('c') mod 16#20# => -- Ctrl('c')
492 declare
493 neww : constant FrameA := new Frame'(null, null,
494 False, False,
495 Null_Window);
496 begin
497 neww.all.wind := getwindow;
498 if neww.all.wind = Null_Window then
499 exit;
500 -- was goto breakout; ha ha ha
501 else
502
503 if current = null then
504 neww.all.next := neww;
505 neww.all.last := neww;
506 else
507 neww.all.next := current.all.next;
508 neww.all.last := current;
509 neww.all.last.all.next := neww;
510 neww.all.next.all.last := neww;
511 end if;
512 current := neww;
513
514 Set_KeyPad_Mode (current.all.wind, True);
515 current.all.do_keypad := HaveKeyPad (current.all.wind);
516 current.all.do_scroll := HaveScroll (current.all.wind);
517 end if;
518 end;
519 when Character'Pos ('N') mod 16#20# => -- Ctrl('N')
520 if current /= null then
521 current := current.all.next;
522 end if;
523 when Character'Pos ('P') mod 16#20# => -- Ctrl('P')
524 if current /= null then
525 current := current.all.last;
526 end if;
527 when Character'Pos ('F') mod 16#20# => -- Ctrl('F')
528 if current /= null and then HaveScroll (current.all.wind) then
529 Scroll (current.all.wind, 1);
530 end if;
531 when Character'Pos ('B') mod 16#20# => -- Ctrl('B')
532 if current /= null and then HaveScroll (current.all.wind) then
533 -- The C version of Scroll may return ERR which is ignored
534 -- we need to avoid the exception
535 -- with the 'and HaveScroll(current.wind)'
536 Scroll (current.all.wind, -1);
537 end if;
538 when Character'Pos ('K') mod 16#20# => -- Ctrl('K')
539 if current /= null then
540 current.all.do_keypad := not current.all.do_keypad;
541 Set_KeyPad_Mode (current.all.wind, current.all.do_keypad);
542 end if;
543 when Character'Pos ('S') mod 16#20# => -- Ctrl('S')
544 if current /= null then
545 current.all.do_scroll := not current.all.do_scroll;
546 Allow_Scrolling (current.all.wind, current.all.do_scroll);
547 end if;
548 when Character'Pos ('W') mod 16#20# => -- Ctrl('W')
549 if current /= current.all.next then
550 Create (f, Name => dumpfile); -- TODO error checking
551 if not Is_Open (f) then
552 raise Curses_Exception;
553 end if;
554 Put_Window (current.all.wind, f);
555 Close (f);
556 current := delete_framed (current, True);
557 end if;
558 when Character'Pos ('R') mod 16#20# => -- Ctrl('R')
559 declare
560 neww : FrameA := new Frame'(null, null, False, False,
561 Null_Window);
562 begin
563 Open (f, Mode => In_File, Name => dumpfile);
564 neww := new Frame'(null, null, False, False, Null_Window);
565
566 neww.all.next := current.all.next;
567 neww.all.last := current;
568 neww.all.last.all.next := neww;
569 neww.all.next.all.last := neww;
570
571 neww.all.wind := Get_Window (f);
572 Close (f);
573
574 Refresh (neww.all.wind);
575 end;
576 when Character'Pos ('X') mod 16#20# => -- Ctrl('X')
577 if current /= null then
578 declare
579 tmp, ul, lr : pair;
580 mx : Column_Position;
581 my : Line_Position;
582 tmpbool : Boolean;
583 begin
584 Move_Cursor (Line => 0, Column => 0);
585 Clear_To_End_Of_Line;
586 Add (Str => "Use arrows to move cursor, anything else " &
587 "to mark new corner");
588 Refresh;
589
590 Get_Window_Position (current.all.wind, ul.y, ul.x);
591
592 selectcell (ul.y, ul.x, Lines - Botlines - 2, Columns - 2,
593 tmp, tmpbool);
594 if not tmpbool then
595 -- the C version had a goto. I refuse gotos.
596 Beep;
597 else
598 Get_Size (current.all.wind, lr.y, lr.x);
599 lr.y := lr.y + ul.y - 1;
600 lr.x := lr.x + ul.x - 1;
601 Outerbox (ul, lr, False);
602 Refresh_Without_Update;
603
604 Get_Size (current.all.wind, my, mx);
605 if my > tmp.y - ul.y then
606 Get_Cursor_Position (current.all.wind, lr.y, lr.x);
607 Move_Cursor (current.all.wind, tmp.y - ul.y + 1, 0);
608 Clear_To_End_Of_Screen (current.all.wind);
609 Move_Cursor (current.all.wind, lr.y, lr.x);
610 end if;
611 if mx > tmp.x - ul.x then
612 for i in 0 .. my - 1 loop
613 Move_Cursor (current.all.wind, i, tmp.x - ul.x + 1);
614 Clear_To_End_Of_Line (current.all.wind);
615 end loop;
616 end if;
617 Refresh_Without_Update (current.all.wind);
618
619 lr := tmp;
620 -- The C version passes invalid args to resize
621 -- which returns an ERR. For Ada we avoid the exception.
622 if lr.y /= ul.y and lr.x /= ul.x then
623 Resize (current.all.wind, lr.y - ul.y + 0,
624 lr.x - ul.x + 0);
625 end if;
626
627 Get_Window_Position (current.all.wind, ul.y, ul.x);
628 Get_Size (current.all.wind, lr.y, lr.x);
629 lr.y := lr.y + ul.y - 1;
630 lr.x := lr.x + ul.x - 1;
631 Outerbox (ul, lr, True);
632 Refresh_Without_Update;
633
634 Refresh_Without_Update (current.all.wind);
635 Move_Cursor (Line => 0, Column => 0);
636 Clear_To_End_Of_Line;
637 Update_Screen;
638 end if;
639 end;
640 end if;
641 when Key_F10 =>
642 declare tmp : pair; tmpbool : Boolean;
643 begin
644 -- undocumented --- use this to test area clears
645 selectcell (0, 0, Lines - 1, Columns - 1, tmp, tmpbool);
646 Clear_To_End_Of_Screen;
647 Refresh;
648 end;
649 when Key_Cursor_Up =>
650 newwin_move (current.all.wind, -1, 0);
651 when Key_Cursor_Down =>
652 newwin_move (current.all.wind, 1, 0);
653 when Key_Cursor_Left =>
654 newwin_move (current.all.wind, 0, -1);
655 when Key_Cursor_Right =>
656 newwin_move (current.all.wind, 0, 1);
657 when Key_Backspace | Key_Delete_Char =>
658 declare
659 y : Line_Position;
660 x : Column_Position;
661 tmp : Line_Position;
662 begin
663 Get_Cursor_Position (current.all.wind, y, x);
664 -- x := x - 1;
665 -- I got tricked by the -1 = Max_Natural - 1 result
666 -- y := y - 1;
667 if not (x = 0 and y = 0) then
668 if x = 0 then
669 y := y - 1;
670 Get_Size (current.all.wind, tmp, x);
671 end if;
672 x := x - 1;
673 Delete_Character (current.all.wind, y, x);
674 end if;
675 end;
676 when others =>
677 -- TODO c = '\r' ?
678 if current /= null then
679 declare
680 begin
681 Add (current.all.wind, Ch => Code_To_Char (c));
682 exception
683 when Curses_Exception => null;
684 -- this happens if we are at the
685 -- lower right of a window and add a character.
686 end;
687 else
688 Beep;
689 end if;
690 end case;
691 newwin_report (current.all.wind);
692 if current /= null then
693 usescr := current.all.wind;
694 else
695 usescr := Standard_Window;
696 end if;
697 Refresh (usescr);
698 c := Getchar (usescr);
699 exit when c = Quit or (c = Escape and HaveKeyPad (usescr));
700 -- TODO when does c = ERR happen?
701 end loop;
702
703 -- TODO while current /= null loop
704 -- current := delete_framed(current, False);
705 -- end loop;
706
707 Allow_Scrolling (Mode => True);
708
709 End_Mouse (Mask2);
710 Set_Raw_Mode (SwitchOn => True);
711 Erase;
712 End_Windows;
713
714 end ncurses2.acs_and_scroll;
Tomato firmware and modifications.