ncurses2-acs_and_scroll.adb

ncurses 库 可能有用酒用 没用就算了 我觉得还可以用

            when KEY_RIGHT =>
               j := j + 1;
            when Key_Mouse =>
               declare
                  event : Mouse_Event;
                  y : Line_Position;
                  x : Column_Position;
                  Button : Mouse_Button;
                  State : Button_State;

               begin
                  event := Get_Mouse;
                  Get_Event (Event => event,
                             Y => y,
                             X => x,
                             Button => Button,
                             State  => State);
                  if y > uli and x > ulj then
                     i := y - uli;
                     j := x - ulj;
                     --  same as when others =>
                     res.y := uli + i;
                     res.x := ulj + j;
                     p := res;
                     b := True;
                     return;
                  else
                     Beep;
                  end if;
               end;
            when others =>
               res.y := uli + i;
               res.x := ulj + j;
               p := res;
               b := True;
               return;
         end case;
         i := i mod si;
         j := j mod sj;
      end loop;
   end selectcell;


   function getwindow return Window is
      rwindow : Window;
      ul, lr : pair;
      result : Boolean;
   begin
      Move_Cursor (Line => 0, Column => 0);
      Clear_To_End_Of_Line;
      Add (Str => "Use arrows to move cursor, anything else to mark corner 1");
      Refresh;
      selectcell (2, 1, Lines - Botlines - 2, Columns - 2, ul, result);
      if not result then
         return Null_Window;
      end if;
      Add (Line => ul.y - 1, Column => ul.x - 1,
           Ch => ACS_Map (ACS_Upper_Left_Corner));
      Move_Cursor (Line => 0, Column => 0);
      Clear_To_End_Of_Line;
      Add (Str => "Use arrows to move cursor, anything else to mark corner 2");
      Refresh;
      selectcell (ul.y, ul.x, Lines - Botlines - 2, Columns - 2, lr, result);
      if not result then
         return Null_Window;
      end if;

      rwindow := Sub_Window (Number_Of_Lines => lr.y - ul.y + 1,
                             Number_Of_Columns => lr.x - ul.x + 1,
                             First_Line_Position => ul.y,
                             First_Column_Position => ul.x);

      Outerbox (ul, lr, True);
      Refresh;

      Refresh (rwindow);

      Move_Cursor (Line => 0, Column => 0);
      Clear_To_End_Of_Line;
      return rwindow;
   end getwindow;


   procedure newwin_move (win : Window;
                          dy  : Line_Position;
                          dx  : Column_Position) is
      cur_y, max_y : Line_Position;
      cur_x, max_x : Column_Position;
   begin
      Get_Cursor_Position (win, cur_y, cur_x);
      Get_Size (win, max_y, max_x);
      cur_x := Column_Position'Min (Column_Position'Max (cur_x + dx, 0),
                                    max_x - 1);
      cur_y := Line_Position'Min (Line_Position'Max (cur_y + dy, 0),
                                  max_y - 1);

      Move_Cursor (win, Line => cur_y, Column => cur_x);
   end newwin_move;

   function delete_framed (fp : FrameA; showit : Boolean) return FrameA is
      np : FrameA;
   begin
      fp.last.next := fp.next;
      fp.next.last := fp.last;

      if showit then
         Erase (fp.wind);
         Refresh (fp.wind);
      end if;
      Delete (fp.wind);

      if fp = fp.next then
         np := null;
      else
         np := fp.next;
      end if;
      --  TODO free(fp);
      return np;
   end delete_framed;

   Mask : Event_Mask := No_Events;
   Mask2 : Event_Mask;

   usescr : Window;

begin
   if Has_Mouse then
      Register_Reportable_Event (
                                 Button => Left,
                                 State => Clicked,
                                 Mask => Mask);
      Mask2 := Start_Mouse (Mask);
   end if;
   c := CTRL ('C');
   Set_Raw_Mode (SwitchOn => True);
   loop
      transient (Standard_Window, "");
      case c is
         when Character'Pos ('c') mod 16#20# => --  Ctrl('c')
            declare
               neww : FrameA := new Frame'(null, null, False, False,
                                           Null_Window);
            begin
               neww.wind := getwindow;
               if neww.wind = Null_Window  then
                  exit;
                  --  was goto breakout; ha ha ha
               else

                  if current = null  then
                     neww.next := neww;
                     neww.last := neww;
                  else
                     neww.next := current.next;
                     neww.last := current;
                     neww.last.next := neww;
                     neww.next.last := neww;
                  end if;
                  current := neww;

                  Set_KeyPad_Mode (current.wind, True);
                  current.do_keypad := HaveKeyPad (current.wind);
                  current.do_scroll := HaveScroll (current.wind);
               end if;
            end;
         when Character'Pos ('N') mod 16#20#  => --  Ctrl('N')
            if current /= null then
               current := current.next;
            end if;
         when Character'Pos ('P') mod 16#20#  => --  Ctrl('P')
            if current /= null then
               current := current.last;
            end if;
         when Character'Pos ('F') mod 16#20#  => --  Ctrl('F')
            if current /= null and HaveScroll (current.wind) then
               Scroll (current.wind, 1);
            end if;
         when Character'Pos ('B') mod 16#20#  => --  Ctrl('B')
            if current /= null and HaveScroll (current.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);
            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);
            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);
            end if;
         when Character'Pos ('W') mod 16#20#  => --  Ctrl('W')
            if current /= current.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);
               Close (f);
               current := delete_framed (current, True);
            end if;
         when Character'Pos ('R') mod 16#20#  => --  Ctrl('R')
            declare
               neww : FrameA := new Frame'(null, null, False, False,
                                           Null_Window);
            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.wind := Get_Window (f);
               Close (f);

               Refresh (neww.wind);
            end;
         when Character'Pos ('X') mod 16#20# => --  Ctrl('X')
            if current /= null then
               declare
                  tmp, ul, lr : pair;
                  mx : Column_Position;
                  my : Line_Position;
                  tmpbool : Boolean;
               begin
                  Move_Cursor (Line => 0, Column => 0);
                  Clear_To_End_Of_Line;
                  Add (Str => "Use arrows to move cursor, anything else " &
                       "to mark new corner");
                  Refresh;

                  Get_Window_Position (current.wind, ul.y, ul.x);

                  selectcell (ul.y, ul.x, Lines - Botlines - 2, Columns - 2,
                              tmp, tmpbool);
                  if not tmpbool then
                     --  the C version had a goto. I refuse gotos.
                     Beep;
                  else
                     Get_Size (current.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);
                     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);
                     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);
                        end loop;
                     end if;
                     Refresh_Without_Update (current.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,
                                lr.x - ul.x + 0);
                     end if;

                     Get_Window_Position (current.wind, ul.y, ul.x);
                     Get_Size (current.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);
                     Move_Cursor (Line => 0, Column => 0);
                     Clear_To_End_Of_Line;
                     Update_Screen;
                  end if;
               end;
            end if;
         when Key_F10  =>
            declare tmp : pair; tmpbool : Boolean;
            begin
               --  undocumented --- use this to test area clears
               selectcell (0, 0, Lines - 1, Columns - 1, tmp, tmpbool);
               Clear_To_End_Of_Screen;
               Refresh;
            end;
         when Key_Cursor_Up =>
            newwin_move (current.wind, -1, 0);
         when Key_Cursor_Down  =>
            newwin_move (current.wind, 1, 0);
         when Key_Cursor_Left  =>
            newwin_move (current.wind, 0, -1);
         when Key_Cursor_Right  =>
            newwin_move (current.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);
               --  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);
                  end if;
                  x := x - 1;
                  Delete_Character (current.wind, y, x);
               end if;
            end;
         when others =>
            --  TODO c = '\r' ?
            if current /= null then
               declare
               begin
                  Add (current.wind, Ch => Code_To_Char (c));
               exception
                  when Curses_Exception => null;
                     --  this happens if we are at the
                     --  lower right of a window and add a character.
               end;
            else
               Beep;
            end if;
      end case;
      newwin_report (current.wind);
      if current /= null then
         usescr := current.wind;
      else
         usescr := Standard_Window;
      end if;
      Refresh (usescr);
      c := Getchar (usescr);
      exit when c = Quit or (c = Escape and HaveKeyPad (usescr));
      --  TODO when does c = ERR happen?
   end loop;

   --  TODO while current /= null loop
   --  current := delete_framed(current, False);
   --  end loop;

   Allow_Scrolling (Mode => True);

   End_Mouse (Mask2);
   Set_Raw_Mode (SwitchOn => True);
   Erase;
   End_Windows;

end ncurses2.acs_and_scroll;