X-Git-Url: https://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=Ada95%2Fsamples%2Fncurses2-acs_and_scroll.adb;h=00e9afc2607897d1f4ffeab15a10c96e90c08a34;hp=65c2939a8597426b277f5675fcfc16892389a088;hb=12b49d3c56a6130feb2d39fbe2d6c1bc0838f0fa;hpb=46722468f47c2b77b3987729b4bcf2321cccfd01 diff --git a/Ada95/samples/ncurses2-acs_and_scroll.adb b/Ada95/samples/ncurses2-acs_and_scroll.adb index 65c2939a..00e9afc2 100644 --- a/Ada95/samples/ncurses2-acs_and_scroll.adb +++ b/Ada95/samples/ncurses2-acs_and_scroll.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 2000 Free Software Foundation, Inc. -- +-- Copyright (c) 2000-2009,2011 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 -- @@ -35,7 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Eugene V. Melaragno 2000 -- Version Control --- $Revision: 1.1 $ +-- $Revision: 1.11 $ +-- $Date: 2011/03/23 00:33:00 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ -- Windows and scrolling tester. @@ -55,14 +56,12 @@ 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 @@ -94,9 +93,6 @@ procedure ncurses2.acs_and_scroll is 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 @@ -172,7 +168,6 @@ procedure ncurses2.acs_and_scroll is when Curses_Exception => return False; end HaveScroll; - procedure newwin_legend (curpw : Window) is package p is new genericPuts (200); @@ -224,8 +219,8 @@ procedure ncurses2.acs_and_scroll is ); buf : Bounded_String; - do_keypad : Boolean := HaveKeyPad (curpw); - do_scroll : Boolean := HaveScroll (curpw); + do_keypad : constant Boolean := HaveKeyPad (curpw); + do_scroll : constant Boolean := HaveScroll (curpw); pos : Natural; @@ -272,7 +267,6 @@ procedure ncurses2.acs_and_scroll is Clear_To_End_Of_Line; end newwin_legend; - procedure transient (curpw : Window; msg : String) is begin newwin_legend (curpw); @@ -289,16 +283,15 @@ procedure ncurses2.acs_and_scroll is else Add (Str => "All other"); end if; - Add (str => " characters are echoed, window should "); + Add (Str => " characters are echoed, window should "); if not HaveScroll (curpw) then Add (Str => "not "); end if; - Add (str => "scroll"); + Add (Str => "scroll"); Clear_To_End_Of_Line; end transient; - procedure newwin_report (win : Window := Standard_Window) is y : Line_Position; x : Column_Position; @@ -331,8 +324,8 @@ procedure ncurses2.acs_and_scroll is res : pair; i : Line_Position := 0; j : Column_Position := 0; - si : Line_Position := lri - uli + 1; - sj : Column_Position := lrj - ulj + 1; + si : constant Line_Position := lri - uli + 1; + sj : constant Column_Position := lrj - ulj + 1; begin res.y := uli; res.x := ulj; @@ -352,7 +345,7 @@ procedure ncurses2.acs_and_scroll is return; when KEY_UP => i := i + si - 1; - -- same as i := i - 1 because of Modulus arithetic, + -- same as i := i - 1 because of Modulus arithmetic, -- on Line_Position, which is a Natural -- the C version uses this form too, interestingly. when KEY_DOWN => @@ -401,7 +394,6 @@ procedure ncurses2.acs_and_scroll is end loop; end selectcell; - function getwindow return Window is rwindow : Window; ul, lr : pair; @@ -441,7 +433,6 @@ procedure ncurses2.acs_and_scroll is return rwindow; end getwindow; - procedure newwin_move (win : Window; dy : Line_Position; dx : Column_Position) is @@ -461,19 +452,19 @@ procedure ncurses2.acs_and_scroll is function delete_framed (fp : FrameA; showit : Boolean) return FrameA is np : FrameA; begin - fp.last.next := fp.next; - fp.next.last := fp.last; + fp.all.last.all.next := fp.all.next; + fp.all.next.all.last := fp.all.last; if showit then - Erase (fp.wind); - Refresh (fp.wind); + Erase (fp.all.wind); + Refresh (fp.all.wind); end if; - Delete (fp.wind); + Delete (fp.all.wind); - if fp = fp.next then + if fp = fp.all.next then np := null; else - np := fp.next; + np := fp.all.next; end if; -- TODO free(fp); return np; @@ -499,67 +490,68 @@ begin case c is when Character'Pos ('c') mod 16#20# => -- Ctrl('c') declare - neww : FrameA := new Frame'(null, null, False, False, - Null_Window); + neww : constant FrameA := new Frame'(null, null, + False, False, + Null_Window); begin - neww.wind := getwindow; - if neww.wind = Null_Window then + neww.all.wind := getwindow; + if neww.all.wind = Null_Window then exit; -- was goto breakout; ha ha ha else if current = null then - neww.next := neww; - neww.last := neww; + neww.all.next := neww; + neww.all.last := neww; else - neww.next := current.next; - neww.last := current; - neww.last.next := neww; - neww.next.last := neww; + neww.all.next := current.all.next; + neww.all.last := current; + neww.all.last.all.next := neww; + neww.all.next.all.last := neww; end if; current := neww; - Set_KeyPad_Mode (current.wind, True); - current.do_keypad := HaveKeyPad (current.wind); - current.do_scroll := HaveScroll (current.wind); + Set_KeyPad_Mode (current.all.wind, True); + current.all.do_keypad := HaveKeyPad (current.all.wind); + current.all.do_scroll := HaveScroll (current.all.wind); end if; end; when Character'Pos ('N') mod 16#20# => -- Ctrl('N') if current /= null then - current := current.next; + current := current.all.next; end if; when Character'Pos ('P') mod 16#20# => -- Ctrl('P') if current /= null then - current := current.last; + current := current.all.last; end if; when Character'Pos ('F') mod 16#20# => -- Ctrl('F') - if current /= null and HaveScroll (current.wind) then - Scroll (current.wind, 1); + if current /= null and then HaveScroll (current.all.wind) then + Scroll (current.all.wind, 1); end if; when Character'Pos ('B') mod 16#20# => -- Ctrl('B') - if current /= null and HaveScroll (current.wind) then + if current /= null and then HaveScroll (current.all.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); + Scroll (current.all.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); + current.all.do_keypad := not current.all.do_keypad; + Set_KeyPad_Mode (current.all.wind, current.all.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); + current.all.do_scroll := not current.all.do_scroll; + Allow_Scrolling (current.all.wind, current.all.do_scroll); end if; when Character'Pos ('W') mod 16#20# => -- Ctrl('W') - if current /= current.next then + if current /= current.all.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); + Put_Window (current.all.wind, f); Close (f); current := delete_framed (current, True); end if; @@ -571,15 +563,15 @@ 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.all.next := current.all.next; + neww.all.last := current; + neww.all.last.all.next := neww; + neww.all.next.all.last := neww; - neww.wind := Get_Window (f); + neww.all.wind := Get_Window (f); Close (f); - Refresh (neww.wind); + Refresh (neww.all.wind); end; when Character'Pos ('X') mod 16#20# => -- Ctrl('X') if current /= null then @@ -595,7 +587,7 @@ begin "to mark new corner"); Refresh; - Get_Window_Position (current.wind, ul.y, ul.x); + Get_Window_Position (current.all.wind, ul.y, ul.x); selectcell (ul.y, ul.x, Lines - Botlines - 2, Columns - 2, tmp, tmpbool); @@ -603,43 +595,43 @@ begin -- the C version had a goto. I refuse gotos. Beep; else - Get_Size (current.wind, lr.y, lr.x); + Get_Size (current.all.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); + Get_Size (current.all.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); + Get_Cursor_Position (current.all.wind, lr.y, lr.x); + Move_Cursor (current.all.wind, tmp.y - ul.y + 1, 0); + Clear_To_End_Of_Screen (current.all.wind); + Move_Cursor (current.all.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); + Move_Cursor (current.all.wind, i, tmp.x - ul.x + 1); + Clear_To_End_Of_Line (current.all.wind); end loop; end if; - Refresh_Without_Update (current.wind); + Refresh_Without_Update (current.all.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, + Resize (current.all.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); + Get_Window_Position (current.all.wind, ul.y, ul.x); + Get_Size (current.all.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); + Refresh_Without_Update (current.all.wind); Move_Cursor (Line => 0, Column => 0); Clear_To_End_Of_Line; Update_Screen; @@ -655,30 +647,30 @@ begin Refresh; end; when Key_Cursor_Up => - newwin_move (current.wind, -1, 0); + newwin_move (current.all.wind, -1, 0); when Key_Cursor_Down => - newwin_move (current.wind, 1, 0); + newwin_move (current.all.wind, 1, 0); when Key_Cursor_Left => - newwin_move (current.wind, 0, -1); + newwin_move (current.all.wind, 0, -1); when Key_Cursor_Right => - newwin_move (current.wind, 0, 1); + newwin_move (current.all.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); + Get_Cursor_Position (current.all.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); + Get_Size (current.all.wind, tmp, x); end if; x := x - 1; - Delete_Character (current.wind, y, x); + Delete_Character (current.all.wind, y, x); end if; end; when others => @@ -686,7 +678,7 @@ begin if current /= null then declare begin - Add (current.wind, Ch => Code_To_Char (c)); + Add (current.all.wind, Ch => Code_To_Char (c)); exception when Curses_Exception => null; -- this happens if we are at the @@ -696,9 +688,9 @@ begin Beep; end if; end case; - newwin_report (current.wind); + newwin_report (current.all.wind); if current /= null then - usescr := current.wind; + usescr := current.all.wind; else usescr := Standard_Window; end if; @@ -714,7 +706,7 @@ begin Allow_Scrolling (Mode => True); - End_Mouse; + End_Mouse (Mask2); Set_Raw_Mode (SwitchOn => True); Erase; End_Windows;