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 45with Ada.Strings.Fixed; 46with Ada.Strings; 47 48with ncurses2.util; use ncurses2.util; 49with ncurses2.genericPuts; 50with Terminal_Interface.Curses; use Terminal_Interface.Curses; 51with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse; 52with Terminal_Interface.Curses.PutWin; use Terminal_Interface.Curses.PutWin; 53 54with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; 55with Ada.Streams; use Ada.Streams; 56 57procedure 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 478begin 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 714end ncurses2.acs_and_scroll; 715