ncurses2-demo_pad.adb

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

                  Erase;
               else -- '?'
                  show_panner_legend := not show_panner_legend;
               end if;
               panner_legend (Lines - 4);
               panner_legend (Lines - 3);
               panner_legend (Lines - 2);
               panner_legend (Lines - 1);
            when Character'Pos ('t') =>
               timing := not timing;
               if not timing then
                  panner_legend (Lines - 1);
               end if;
            when Character'Pos ('s') =>
               scrollers := not scrollers;

               --  Move the top-left corner of the pad, keeping the
               --  bottom-right corner fixed.
            when Character'Pos ('h') =>
               --  increase-columns: move left edge to left
               if top_x <= 0 then
                  Beep;
               else
                  panner_v_cleanup (top_y, top_x, porty);
                  top_x := top_x - 1;
               end if;

            when Character'Pos ('j') =>
               --  decrease-lines: move top-edge down
               if top_y >= porty then
                  Beep;
               else
                  if top_y /= 0 then
                     panner_h_cleanup (top_y - 1, f (top_x), portx);
                  end if;
                  top_y := top_y + 1;
               end if;
            when Character'Pos ('k') =>
               --  increase-lines: move top-edge up
               if top_y <= 0 then
                  Beep;
               else
                  top_y := top_y - 1;
                  panner_h_cleanup (top_y, top_x, portx);
               end if;

            when Character'Pos ('l') =>
               --  decrease-columns: move left-edge to right
               if top_x >= portx then
                  Beep;
               else
                  if top_x /= 0 then
                     panner_v_cleanup (f (top_y), top_x - 1, porty);
                  end if;
                  top_x := top_x + 1;
               end if;

               --  Move the bottom-right corner of the pad, keeping the
               --  top-left corner fixed.
            when Key_Insert_Char =>
               --  increase-columns: move right-edge to right
               if portx >= pxmax or portx >= Columns then
                  Beep;
               else
                  panner_v_cleanup (f (top_y), portx - 1, porty);
                  portx := portx + 1;
                  --  C had ++portx instead of portx++, weird.
               end if;
            when Key_Insert_Line =>
               --  increase-lines: move bottom-edge down
               if porty >= pymax or porty >= Lines then
                  Beep;
               else
                  panner_h_cleanup (porty - 1, f (top_x), portx);
                  porty := porty + 1;
               end if;

            when Key_Delete_Char =>
               --  decrease-columns: move bottom edge up
               if portx <= top_x then
                  Beep;
               else
                  portx := portx - 1;
                  panner_v_cleanup (f (top_y), portx, porty);
               end if;

            when Key_Delete_Line =>
               --  decrease-lines
               if porty <= top_y then
                  Beep;
               else
                  porty := porty - 1;
                  panner_h_cleanup (porty, f (top_x), portx);
               end if;
            when Key_Cursor_Left =>
               --  pan leftwards
               if basex > 0 then
                  basex := basex - 1;
               else
                  Beep;
               end if;
            when Key_Cursor_Right =>
               --  pan rightwards
               --  if (basex + portx - (pymax > porty) < pxmax)
               if basex + portx -
                   Column_Position (greater (pymax, porty)) < pxmax then
                  --  if basex + portx  < pxmax or
                  --      (pymax > porty and basex + portx - 1 < pxmax) then
                  basex := basex + 1;
               else
                  Beep;
               end if;

            when Key_Cursor_Up =>
               --  pan upwards
               if basey > 0 then
                  basey := basey - 1;
               else
                  Beep;
               end if;

            when Key_Cursor_Down =>
               --  pan downwards
               --  same as if (basey + porty - (pxmax > portx) < pymax)
               if basey + porty -
                   Line_Position (greater (pxmax, portx)) < pymax then
                  --  if (basey + porty  < pymax) or
                  --      (pxmax > portx and basey + porty - 1 < pymax) then
                  basey := basey + 1;
               else
                  Beep;
               end if;

            when  Character'Pos ('H') |
              Key_Home |
              Key_Find =>
               basey := 0;

            when   Character'Pos ('E') |
              Key_End |
              Key_Select =>
               if pymax < porty then
                  basey := 0;
               else
                  basey := pymax - porty;
               end if;

            when others =>
               Beep;
         end case;

         --  more writing off the screen.
         --  Interestingly, the exception is not handled if
         --  we put a block around this.
         --  delcare --begin
         if top_y /= 0 and top_x /= 0 then
            Add (Line => top_y - 1, Column => top_x - 1,
                 Ch => ACS_Map (ACS_Upper_Left_Corner));
         end if;
         if top_x /= 0 then
            do_v_line (top_y, top_x - 1, ACS_Map (ACS_Vertical_Line), porty);
         end if;
         if top_y /= 0 then
            do_h_line (top_y - 1, top_x, ACS_Map (ACS_Horizontal_Line), portx);
         end if;
         --  exception when Curses_Exception => null; end;

         --  in C was ... pxmax > portx - 1
         if scrollers and pxmax >= portx then
            declare
               length : constant Column_Position := portx - top_x - 1;
               lowend, highend : Column_Position;
            begin
               --  Instead of using floats, I'll use integers only.
               lowend := top_x + (basex * length) / pxmax;
               highend := top_x + ((basex + length) * length) / pxmax;

               do_h_line (porty - 1, top_x, ACS_Map (ACS_Horizontal_Line),
                          lowend);
               if highend < portx then
                  Switch_Character_Attribute
                    (Attr => (Reverse_Video => True, others => False),
                     On => True);
                  do_h_line (porty - 1, lowend, Blank2, highend + 1);
                  Switch_Character_Attribute
                    (Attr => (Reverse_Video => True, others => False),
                     On => False);
                  do_h_line (porty - 1, highend + 1,
                             ACS_Map (ACS_Horizontal_Line), portx);
               end if;
            end;
         else
            do_h_line (porty - 1, top_x, ACS_Map (ACS_Horizontal_Line), portx);
         end if;

         if scrollers and pymax >= porty then
            declare
               length : constant Line_Position := porty - top_y - 1;
               lowend, highend : Line_Position;
            begin
               lowend := top_y + (basey * length) / pymax;
               highend := top_y + ((basey + length) * length) / pymax;

               do_v_line (top_y, portx - 1, ACS_Map (ACS_Vertical_Line),
                          lowend);
               if highend < porty then
                  Switch_Character_Attribute
                    (Attr => (Reverse_Video => True, others => False),
                     On => True);
                  do_v_line (lowend, portx - 1, Blank2, highend + 1);
                  Switch_Character_Attribute
                    (Attr => (Reverse_Video => True, others => False),
                     On => False);
                  do_v_line (highend + 1, portx - 1,
                             ACS_Map (ACS_Vertical_Line), porty);
               end if;
            end;
         else
            do_v_line (top_y, portx - 1, ACS_Map (ACS_Vertical_Line), porty);
         end if;

         if top_y /= 0 then
            Add (Line => top_y - 1, Column => portx - 1,
                 Ch => ACS_Map (ACS_Upper_Right_Corner));
         end if;
         if top_x /= 0 then
            Add (Line => porty - 1, Column => top_x - 1,
                 Ch => ACS_Map (ACS_Lower_Left_Corner));
         end if;
         declare
         begin
            --  Here is another place where it is possible
            --  to write to the corner of the screen.
            Add (Line => porty - 1, Column => portx - 1,
                 Ch => ACS_Map (ACS_Lower_Right_Corner));
            exception
            when Curses_Exception => null;
         end;

         before := gettime;

         Refresh_Without_Update;

         declare
            --  the C version allows the panel to have a zero height
            --  wich raise the exception
         begin
            Refresh_Without_Update
              (
               pad,
               basey, basex,
               top_y, top_x,
               porty - Line_Position (greater (pxmax, portx)) - 1,
               portx - Column_Position (greater (pymax, porty)) - 1);
            exception
            when Curses_Exception => null;
         end;

         Update_Screen;

         if timing then declare
            s : String (1 .. 7);
            elapsed : Long_Float;
         begin
            after := gettime;
            elapsed := (Long_Float (after.seconds - before.seconds) +
                        Long_Float (after.microseconds - before.microseconds)
                        / 1.0e6);
            Move_Cursor (Line => Lines - 1, Column => Columns - 20);
            floatio.Put (s, elapsed, Aft => 3, Exp => 0);
            Add (Str => s);
            Refresh;
         end;
         end if;

         c := pgetc (pad);
         exit when c = Key_Exit;

      end loop;

      Allow_Scrolling (Mode => True);

   end panner;

   Gridsize : constant := 3;
   Gridcount : Integer := 0;

   Pad_High : constant Line_Count :=  200;
   Pad_Wide : constant Column_Count := 200;
   panpad : Window := New_Pad (Pad_High, Pad_Wide);
begin
   if panpad = Null_Window then
      Cannot ("cannot create requested pad");
      return;
   end if;

   for i in 0 .. Pad_High - 1 loop
      for j in 0 .. Pad_Wide - 1  loop
         if i mod Gridsize = 0 and j mod Gridsize = 0 then
            if i = 0 or j = 0 then
               Add (panpad, '+');
            else
               --  depends on ASCII?
               Add (panpad,
                    Ch => Character'Val (Character'Pos ('A') +
                                         Gridcount mod 26));
               Gridcount := Gridcount + 1;
            end if;
         elsif i mod Gridsize = 0 then
            Add (panpad, '-');
         elsif j mod Gridsize = 0 then
            Add (panpad, '|');
         else
            declare
               --  handle the write to the lower right corner error
            begin
               Add (panpad, ' ');
               exception
               when Curses_Exception => null;
            end;
         end if;
      end loop;
   end loop;
   panner_legend (Lines - 4);
   panner_legend (Lines - 3);
   panner_legend (Lines - 2);
   panner_legend (Lines - 1);

   Set_KeyPad_Mode (panpad, True);
   --  Make the pad (initially) narrow enough that a trace file won't wrap.
   --  We'll still be able to widen it during a test, since that's required
   --  for testing boundaries.

   panner (panpad, 2, 2, Lines - 5, Columns - 15, padgetch'Access);

   Delete (panpad);
   End_Windows; --  Hmm, Erase after End_Windows
   Erase;
end ncurses2.demo_pad;